Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1620to1624
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Für mich unverständliche VBA Fehlermeldung

Für mich unverständliche VBA Fehlermeldung
11.05.2018 11:08:56
Lilli
hallo Allerseits,
mir wurde vor einigen Woche hier ein VBA Code zu bekommen um eine Aufgabe zu lösen. Das hat auch unter Excel 2010 sehr gut funktioniert.
Jetzt bin ich gerade dabei dies unter Excel 2016 zu probieren und bekomme eine Fehlermeldung, womit ich leider gar nichts anfangen kann:
---------------------------------------------------------------------------------
Option Explicit
' _
Dieses Ereignis tritt ein, wenn eine Zelle doppelklicket wird

Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, cancel As Boolean)
Dim x As Long
Dim arrZeichen
Dim arrFarbe
Dim arrSchriftart
If Not Intersect(target, Range("P10:AE259")) Is Nothing Then  
'        Hier kann man die Wechselnde Einträge pflegen    (Der Bereich kann beliebig erweitert   _
_
_
werden.
' hier wird der Bereich gekennzeichnet.
arrZeichen = Array("", "ü", "û")                                                '    _
_
_
hier werden die Einträge gepflegt.
arrFarbe = Array(vbBlue, vbGreen, vbRed)                                        '    _
_
_
hier werden die Farben geflegt.
arrSchriftart = Array("Calibri", "Wingdings", "Wingdings")                      '    _
_
_
hier werden die Schriftarten gepflegt.
''        Hier kann man die Wechselnde Einträge pflegen    (Der Bereich kann beliebig erweitert  _
_
_
werden.
'        ElseIf Not Intersect(target, Range("H10:H259")) Is Nothing Then                     '   _
_
_
hier wird der Bereich gekennzeichnet.
'            arrSchriftart = Array("Verdana", "Verdana", "Verdana")                          '   _
_
_
hier werden die Schriftarten gepflegt.
'            arrZeichen = Array("fix", "beweglich", "")                                      '   _
_
_
hier werden die Einträge gepflegt.
'            arrFarbe = Array(vbBlue, vbBlue, vbBlue)                                        '   _
_
_
hier werden die Farben geflegt.
''        Hier kann man die Wechselnde Einträge pflegen    (Der Bereich kann beliebig erweitert  _
_
_
werden.
'        ElseIf Not Intersect(target, Range("I10:I259")) Is Nothing Then                     '   _
_
_
hier wird der Bereich gekennzeichnet.
'            arrSchriftart = Array("Verdana", "Verdana", "Verdana")                          '   _
_
_
hier werden die Schriftarten gepflegt.
'            arrZeichen = Array("Voll", "Halb", "")                                          '   _
_
_
hier werden die Einträge gepflegt.
'            arrFarbe = Array(vbBlue, vbBlue, vbBlue)                                        '   _
_
_
hier werden die Farben geflegt.
''        Hier kann man die Wechselnde Einträge pflegen    (Der Bereich kann beliebig erweitert  _
_
_
werden.
'        ElseIf Not Intersect(target, Range("J10:J259")) Is Nothing Then                     '   _
_
_
hier wird der Bereich gekennzeichnet.
'            arrSchriftart = Array("Verdana", "Verdana", "Verdana")                          '   _
_
_
hier werden die Schriftarten gepflegt.
'            arrZeichen = Array("Ja", "Nein", "")                                            '   _
_
_
hier werden die Einträge gepflegt.
'            arrFarbe = Array(vbBlue, vbBlue, vbBlue)                                        '   _
_
_
hier werden die Farben geflegt.
Else
Exit Sub
End If
On Error Resume Next
x = WorksheetFunction.Match(target.Value & "", arrZeichen, 0)
On Error GoTo 0
x = x Mod (UBound(arrZeichen) + 1)
target.Value = arrZeichen(x)
target.Font.Color = arrFarbe(x)
target.Font.Name = arrSchriftart(x)
cancel = True
End Sub

---------------------------------------------------------------------------------
Folgende Fehlermeldung bekomme ich immer wieder:
Fehler beim Kompilieren:
Sub oder Function nicht defibniert.
Kann mir bitte jemand helfen zu erfahren, was gemacht werden soll?
vielen Dank für die Mühe und Feedback im Voraus.
Liebe Grüße, Lilli :)

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Für mich unverständliche VBA Fehlermeldung
11.05.2018 11:47:40
Werner
Hallo Lilli,
für eine Hilfe wäre es jetzt nicht uninteressant gewesen zu wissen, in welcher Codezeile der Fehler ausgelöst wird.
Sei mir nicht böse, aber mit deinen ganzen Kommentaren hast du den Code völlig durcheinander gebracht, der ist so quasi unlesbar.
Ich kann den Fehler nicht nachvollziehen, hab im Moment hier aber auch nur 2010 zur Verfügung.
Ich hab die ganzen Kommentare mal raus geschmissen, vielleicht hast du dir ja dabei was zerschossen. Probier den Code mal so:
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim x As Long
Dim arrZeichen
Dim arrFarbe
Dim arrSchriftart
If Not Intersect(Target, Range("P10:AE259")) Is Nothing Then
arrZeichen = Array("", "ü", "û")
arrFarbe = Array(vbBlue, vbGreen, vbRed)
arrSchriftart = Array("Calibri", "Wingdings", "Wingdings")
ElseIf Not Intersect(Target, Range("H10:H259")) Is Nothing Then
arrSchriftart = Array("Verdana", "Verdana", "Verdana")
arrZeichen = Array("fix", "beweglich", "")
arrFarbe = Array(vbBlue, vbBlue, vbBlue)
ElseIf Not Intersect(Target, Range("I10:I259")) Is Nothing Then
arrSchriftart = Array("Verdana", "Verdana", "Verdana")
arrZeichen = Array("Voll", "Halb", "")
arrFarbe = Array(vbBlue, vbBlue, vbBlue)
ElseIf Not Intersect(Target, Range("J10:J259")) Is Nothing Then
arrSchriftart = Array("Verdana", "Verdana", "Verdana")
arrZeichen = Array("Ja", "Nein", "")
arrFarbe = Array(vbBlue, vbBlue, vbBlue)
Else
Exit Sub
End If
On Error Resume Next
x = WorksheetFunction.Match(Target.Value & "", arrZeichen, 0)
On Error GoTo 0
x = x Mod (UBound(arrZeichen) + 1)
Target.Value = arrZeichen(x)
Target.Font.Color = arrFarbe(x)
Target.Font.Name = arrSchriftart(x)
Cancel = True
End Sub
Gruß Werner
Anzeige
AW: Für mich unverständliche VBA Fehlermeldung
11.05.2018 13:01:02
Lilli
hallo Werner,
vielen Dank für Deine Hilfe. Dein Code funktioniert einwandfrei. Vielen Dank für Deine Mühe.
Das nächste mal werde ich darauf achten die Zeile zu markieren oder zu erwähnen, wo der Fehler ist. Das habe ich nicht gewusst, dass das auch wichtig ist. Aber absolut nachvollziehbar.
Vielen Dank für den Hinweis.
Vielen Dank für Deine Mühe noch mal.
Liebe Grüße, Lilli
AW: Für mich unverständliche VBA Fehlermeldung
11.05.2018 13:44:56
Lilli
Hallo Werner,
das steht zwar nicht in der Aufgabe drin, aber ich wollte fragen, ob du mir vielleicht schreiben kannst, wie ich die Farbe von der Schrift statt mit den VbBlue,...
mit den ColorIndex Farben arbeiten kann. Ich habe im Netz gesehen, dass da mehr Möglichkeit gibt als die 5-6 Begriffe, die ich kenne.
vielen Dank...
liebe Grüße,
Lilli :)
Anzeige
AW: Für mich unverständliche VBA Fehlermeldung
11.05.2018 20:48:20
Werner
Hallo Lilli,
dann so:
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim x As Long
Dim arrZeichen
Dim arrFarbe
Dim arrSchriftart
If Not Intersect(Target, Range("P10:AE259")) Is Nothing Then
arrZeichen = Array("", "ü", "û")
arrFarbe = Array(5, 3, 33)
arrSchriftart = Array("Calibri", "Wingdings", "Wingdings")
ElseIf Not Intersect(Target, Range("H10:H259")) Is Nothing Then
arrSchriftart = Array("Verdana", "Verdana", "Verdana")
arrZeichen = Array("fix", "beweglich", "")
arrFarbe = Array(5, 3, 33)
ElseIf Not Intersect(Target, Range("I10:I259")) Is Nothing Then
arrSchriftart = Array("Verdana", "Verdana", "Verdana")
arrZeichen = Array("Voll", "Halb", "")
arrFarbe = Array(5, 3, 33)
ElseIf Not Intersect(Target, Range("J10:J259")) Is Nothing Then
arrSchriftart = Array("Verdana", "Verdana", "Verdana")
arrZeichen = Array("Ja", "Nein", "")
arrFarbe = Array(5, 3, 33)
Else
Exit Sub
End If
On Error Resume Next
x = WorksheetFunction.Match(Target.Value & "", arrZeichen, 0)
On Error GoTo 0
x = x Mod (UBound(arrZeichen) + 1)
Target.Value = arrZeichen(x)
Target.Font.ColorIndex = arrFarbe(x)
Target.Font.Name = arrSchriftart(x)
Cancel = True
End Sub
Hab halt jetzt mal einfach irgendwelche Farben rein gekloppt.
Gruß Werner
Anzeige
AW: Für mich unverständliche VBA Fehlermeldung
14.05.2018 07:53:54
Lilli
Guten Morgen Werner,
Vielen Dank für Deine Mühe.
Das gibt mir jetzt die Gelegenheit weitere Farben zu nutzen. Das ist sehr gut.
Ich werde versuchen spätestens bis morgen Abend zu testen und Dir ein Feedback geben.
Vielen Dank noch mal für Deine Mühe und einen guten Start in der Woche.
Liebe Grüße,
Lilli
AW: Für mich unverständliche VBA Fehlermeldung
11.05.2018 12:40:54
onur
Mich irritiert, daß bei Zeile:
Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, cancel As Boolean)

"cancel" und "target" klein geschrieben sind - normal wäre: "Cancel" und "Target" - Hast du die Sub etwa selbst geschrieben, statt die fertige des Worksheets zu nehmen?
Anzeige
AW: Für mich unverständliche VBA Fehlermeldung
11.05.2018 13:10:09
Lilli
Hallo Onur,
die Zeile habe ich zuerst reinkopiert und als der Fehler erschienen ist, habe ich das selbst noch mal getippt, ich dachte, es würde helfen. Tat es aber leider nicht.
Ich habe es geändert. Vielen Dank für Deine Mühe.
Hast du die Sub etwa selbst geschrieben, statt die fertige des Worksheets zu nehmen?
magst du mir bitte erklären, was du damit meinst, mit den fertigen Worksheets zu nehmen?
vielen Dank im Voraus.
Viele Grüße,
Lilli
AW: Für mich unverständliche VBA Fehlermeldung
11.05.2018 15:08:51
onur
Wenn du im VBA-Editor im Projekt-Explorer auf (z.B.) Tabelle1 doppelklickst, öffnet sich der Code von Tabelle1.
Da kannst du oben links (Dropdown - steht normalerweise auf "Allgemein") "Worksheet" auswählen und dann im rechten Dropdown (fast) alle möglichen Events auswählen.
Da brauchst du nur noch zw.

Private Sub ...
und

End Sub
deinen Code zu schreiben.
Anzeige
AW: Für mich unverständliche VBA Fehlermeldung
11.05.2018 15:28:54
Lilli
Hallo Onur,
Vielen Dank für die Erklärung.
viele Grüße,
Lilli :)

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige