Hallo,
ich verwende in einer Tabelle 2 VBA-Codes, die jeweils allein genutzt voll funktionsfähig sind. Aber wenn ich beide Codes in die Tabelle kopiere, kommt es zu Fehlermeldung.
Wie gebe ich Excel zu verstehen, dass es zwei getrennte Codes sind
Danke und Gruß Markus
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("AO2:AU1560"), Target) Is Nothing Then
Application.EnableEvents = False
Target.Value = IIf(Target.Value = "x", "", "x")
Application.EnableEvents = True
Cancel = True
End If
End Sub
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$2" Then
If Target.Value <> "" Then
Call FliegendeBalloons
Target.ClearContents ' Löscht den Eintrag in Zelle A1 nach dem Starten des Codes
End If
End If
End Sub
Sub FliegendeBalloons()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Spende Michael") ' Arbeitsblattname "Sp Michael"
Dim balloon As Object
Dim i As Integer
For i = 1 To 10 ' Ändern Sie die Anzahl der gewünschten Ballons
Set balloon = ws.Shapes.AddShape(msoShapeOval, Rnd * 1000, Rnd * 500, 50, 50)
balloon.Fill.ForeColor.RGB = RGB(Rnd * 256, Rnd * 256, Rnd * 256)
balloon.Line.Visible = msoFalse
balloon.TextFrame.Characters.Text = "??"
balloon.Name = "Balloon" & i
Call AnimateBalloon(balloon)
Next i
End Sub
Sub AnimateBalloon(balloon As Object)
Dim topPosition As Double
topPosition = balloon.Top
Do While topPosition > 0
topPosition = topPosition - 1
balloon.Top = topPosition
DoEvents
Loop
balloon.Delete
End Sub
Es wäre hilfreich, die genaue Fehlermeldung zu kennen, um das Problem besser zu verstehen.
Ohne die Fehlermeldung ist es schwierig, gezielte Ratschläge zu geben.
Falls du die Fehlermeldung zur Hand hast, teile sie bitte mit.
Es ist in der Tat sinnvoll, die Fehlermeldung zuerst zu erwähnen, da sie wichtige Hinweise auf das Problem geben kann.
beim Ausführen des ersten Codes wird Fehlermeldung siehe Anhang angezeigt.
beim Ausführen des zweiten Codes wird nichts angezeigt, es passier einfach nichts.
Hatte überlegt den zweiten Code einfach in ein Modul einzufügen - passiert aber auch nichts.
Gruß Markus[
attachment=49663]
Da reicht ChatGPT:
Die Fehlermeldung "Mehrdeutiger Name Worksheet_BeforeDoubleCLick()" tritt in VBA (Visual Basic for Applications) auf, wenn Sie versuchen, ein Ereignis in einem Arbeitsblatt (Worksheet) zu behandeln, das bereits anderswo im Code behandelt wird. Dies kann passieren, wenn Sie denselben Ereignisnamen in verschiedenen Modulen oder Arbeitsmappen verwenden. Um diesen Fehler zu beheben, müssen Sie sicherstellen, dass der Ereignisname eindeutig ist.
Hier sind einige Schritte, die Sie befolgen können, um diesen Fehler zu beseitigen:
Überprüfen Sie den Code im aktuellen Modul: Stellen Sie sicher, dass in dem aktuellen Modul oder der aktuellen Arbeitsmappe, in der Sie arbeiten, keine andere Prozedur mit dem Namen "Worksheet_BeforeDoubleCLick()" vorhanden ist. Wenn dies der Fall ist, sollten Sie eine der Prozeduren umbenennen, um Namenskonflikte zu vermeiden.
Überprüfen Sie andere Arbeitsmappen: Wenn Sie mit mehreren Arbeitsmappen arbeiten, stellen Sie sicher, dass es in keiner anderen geöffneten Arbeitsmappe eine Prozedur mit dem gleichen Namen gibt.
Überprüfen Sie den Arbeitsblattnamen: Stellen Sie sicher, dass Sie den richtigen Namen des Arbeitsblatts verwenden, auf dem Sie das Doppelklicken-Ereignis behandeln möchten. Der Ereigniscode sollte in dem Arbeitsblattmodul platziert werden, das das Ereignis auslöst.
Ja danke, eigentlich wollte ich an den Codes nichts ändern, weil diese funktionieren.
Dachte, dass man durch irgeneine Markierung beide problemlos voneinander trennen kann.
Google hat mir auch noch keine Antwort geliefert.
Ich tüftle morgen weiter
Hallo Markus,
habe nur eine Fehlermeldung, da du die folgende Zeile auskommentiert hattest:
Code:
' Set ws = ThisWorkbook.Sheets("Spende Michael") ' Arbeitsblattname "Sp Michael"
Ist die Werteingabe in C2 > "" fliegt der Ballon los und wechselt die Farbe und die Flug- Spalten.
Ich sehe auch keinen Grund, weshalb sich die Makros störten sollten.
Alle Makros befinden sich im Arbeitsblatt "Spende Michael"
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("AO2:AU1560"), Target) Is Nothing Then
Application.EnableEvents = False
Target.Value = IIf(Target.Value = "x", "", "x")
Application.EnableEvents = True
Cancel = True
End If
End Sub
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$2" Then
If Target.Value <> "" Then
Call FliegendeBalloons
Target.ClearContents ' Löscht den Eintrag in Zelle A1 nach dem Starten des Codes
End If
End If
End Sub
Code:
Sub FliegendeBalloons()
Dim ws As Worksheet
Dim balloon As Object
Dim i As Integer
Set ws = ThisWorkbook.Sheets("Spende Michael") ' Arbeitsblattname "Sp Michael"
For i = 1 To 10 ' Ändern Sie die Anzahl der gewünschten Ballons
Set balloon = ws.Shapes.AddShape(msoShapeOval, Rnd * 1000, Rnd * 500, 50, 50)
balloon.Fill.ForeColor.RGB = RGB(Rnd * 256, Rnd * 256, Rnd * 256)
balloon.Line.Visible = msoFalse
balloon.TextFrame.Characters.Text = "??"
balloon.Name = "Balloon" & i
Call AnimateBalloon(balloon)
Next i
End Sub
Code:
Sub AnimateBalloon(balloon As Object)
Dim topPosition As Double
topPosition = balloon.Top
Do While topPosition > 0
topPosition = topPosition - 1
balloon.Top = topPosition
DoEvents
Loop
balloon.Delete
End Sub
Moin Karl,
vielen lieben Dank für die Lösung. Klappt super!!
Damit die Zahl nach dem Fliegen der Ballons auch in C2 verbleibt habe ich folgende Zeile gelöscht:
Code:
Target.ClearContents ' Löscht den Eintrag in Zelle C2 nach dem Starten des Codes
Das klappt dann auch.
Möchte aber gerne die Zellen erweitern. Ballons sollen fliegen, wenn ein Eintrag in C2:C11
Das funktioniert nicht.
Hast du ein Idee?
Hatte das so gedacht:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$2:$C$11" Then
If Target.Value <> "" Then
Call FliegendeBalloons
End If
End If
End Sub
Gruß Markus
Code:
If Target.Address = "C2:C11" Then
Hatte gedacht,dass eventuell so geändert werden müßte, klappt aber auch nicht
Hi,
ich glaube, Du solltest Dir noch ein paar Grundlagen in VBA erarbeiten:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If intersect(Target, Range("$C$2:$C$11")) is nothing Then exit sub
If Target.Value <> "" Then Call FliegendeBalloons
End Sub
Hallo Edgar,
perfekt danke!
Viele Grüße