ich hab mit einer Dateneingabemaske ein Problem.
Er bringt mir den Fehler "Fehler beim Kompilieren", "Syntaxfehler"
In der Dateneingabemaske ist ein Zähler, der die Nr. des Datensatzes anzeigen soll. Aber er zählt leider nicht. Die Datensätze wechseln auch nicht.
Der Fehler wird angezeigt bei den von mir markierten Zeilen - Sub rückwärts()und danach r = 1Zeile
Sub eintragen()
Dim TB1, TB2 As Worksheet
Set TB1 = ThisWorkbook.Worksheets(1)
Set TB2 = ThisWorkbook.Worksheets(2)
Application.ScreenUpdating = False
lZeile = TB2.Cells(Rows.Count, 1).End(xlUp).Row
'Zelle H15 Entsperren
TB1.Unprotect
Range("H15").Select
Selection.Locked = False
'Nächster Datensatz
TB1.[H15] = lZeile + 1
'Zelle H15 wieder sperren
Range("H15").Select
Selection.Locked = True
TB1.Protect
If [D6] = "" And [d7] = "" Then
MsgBox "Bitte geben Sie einen Namen ein"
[D6].Select
Exit Sub
End If
If [D6].Value = "" Then [D6].Value = "---"
If [d7].Value = "" Then [d7].Value = "---"
If [d10].Value = "" Then [d10].Value = "---"
If [d32].Value = "" Then [d32].Value = "---"
GeänderteEintragen
Application.ScreenUpdating = True
End Sub
'Berti:
Sub Vorwärts()
Dim r, lZeile As Variant
Dim s As String
'Mit diesen 3 Zeilen definiert man die unterschiedlichen Tabellenblätter,
'damit der Makrotext übersichtlicher bleibt.
Dim TB1, TB2 As Worksheet
Set TB1 = ThisWorkbook.Worksheets(1)
Set TB2 = ThisWorkbook.Worksheets(2)
'Zelle H15 Entsperren
TB1.Unprotect
Range("H15").Select
Selection.Locked = False
'Nächster Datensatz
r = TB1.[H15] + 1
lZeile = TB2.Cells(Rows.Count, 1).End(xlUp).Row
If r > lZeile Then
MsgBox "Das Ende ist erreicht, Es geht jetzt beim ersten Datensatz weiter"
r = 2
End If
TB1.[H15] = r
'Zelle H15 wieder sperren
Range("H15").Select
Selection.Locked = True
TB1.Protect
DatenInTab1Eintragen
End Sub
'Berti:
Sub Rückwärts() <------
Dim Bereich As Range
Dim r, lZeile As Variant
Dim s As String
'Mit diesen 3 Zeilen definiert man die unterschiedlichen Tabellenblätter,
'damit der Makrotext übersichtlicher bleibt.
Dim TB1, TB2 As Worksheet
Set TB1 = ThisWorkbook.Worksheets(1)
Set TB2 = ThisWorkbook.Worksheets(2)
'Zelle H15 Entsperren
TB1.Unprotect
Range("H15").Select
Selection.Locked = False
'Nächster Datensatz
r = TB1.[H15] - 1
lZeile = TB2.Cells(Rows.Count, 1).End(xlUp).Row
If r < 2 Then
MsgBox "Der Anfang ist erreicht, Es geht jetzt beim letzten Datensatz weiter"
r = 1Zeile <-------
End If
'Jetzt wird eingetragen:
TB1.[H15] = r
'Zelle G14 wieder sperren
Range("H15").Select
Selection.Locked = True
TB1.Protect
DatenInTab1Eintragen
End Sub
'Berti:
Sub GeänderteEintragen()
Dim Bereich As Range
Dim r, lZeile As Variant
Dim s As String
'Mit diesen 3 Zeilen definiert man die unterschiedlichen Tabellenblätter,
'damit der Makrotext übersichtlicher bleibt.
Dim TB1, TB2 As Worksheet
Set TB1 = ThisWorkbook.Worksheets(1)
Set TB2 = ThisWorkbook.Worksheets(2)
Application.ScreenUpdating = False
'aktueller Datensatz
r = TB1.[H15]
'Jetzt wird eingetragen:
TB2.Unprotect
TB2.Cells(r, 1) = TB1.[D6]
TB2.Cells(r, 2) = TB1.[d7]
TB2.Cells(r, 3) = TB1.[d8]
TB2.Cells(r, 4) = TB1.[d9]
TB2.Cells(r, 5) = TB1.[d10]
TB2.Cells(r, 6) = TB1.[d11]
TB2.Cells(r, 7) = TB1.[d12]
TB2.Cells(r, 8) = TB1.[d13]
TB2.Cells(r, 9) = TB1.[d14]
If TB1.[d15] <> "" Then
TB2.Cells(r, 10) = TB1.[d15]
TB2.Cells(r, 10).Hyperlinks.Add Anchor:=TB2.Cells(r, 10), Address:="mailto:" & TB1.[d15]
End If
TB2.Cells(r, 11) = TB1.[d16]
TB2.Cells(r, 12) = TB1.[d17]
TB2.Cells(r, 13) = TB1.[d18]
TB2.Cells(r, 14) = TB1.[d19]
TB2.Cells(r, 15) = TB1.[d20]
TB2.Cells(r, 16) = TB1.[d21]
TB2.Cells(r, 17) = TB1.[d22]
TB2.Cells(r, 18) = TB1.[d23]
TB2.Cells(r, 19) = TB1.[d24]
TB2.Cells(r, 20) = TB1.[d25]
TB2.Cells(r, 21) = TB1.[d26]
TB2.Cells(r, 22) = TB1.[d27]
TB2.Cells(r, 23) = TB1.[d28]
TB2.Cells(r, 24) = TB1.[d29]
TB2.Cells(r, 25) = TB1.[d30]
TB2.Cells(r, 26) = TB1.[d31]
TB2.Cells(r, 27) = TB1.[d32]
TB2.Cells(r, 28) = TB1.[d33]
TB2.Cells(r, 29) = TB1.[d34]
TB2.Cells(r, 30) = TB1.[d35]
TB2.Cells(r, 28) = TB1.[d33]
ListeSortieren_NN_VN
TB2.Protect
Application.ScreenUpdating = True
End Sub
'Hier wird eingetragen:
Sub DatenInTab1Eintragen()
Dim r As Variant
'Mit diesen 3 Zeilen definiert man die unterschiedlichen Tabellenblätter,
'damit der Makrotext übersichtlicher bleibt.
Dim TB1, TB2 As Worksheet
Set TB1 = ThisWorkbook.Worksheets(1)
Set TB2 = ThisWorkbook.Worksheets(2)
Application.ScreenUpdating = False
'Zeile aus holen:
r = TB1.[H15]
TB1.[D6:D35].ClearContents
TB1.[d33].ClearContents
TB1.[D6] = TB2.Cells(r, 1)
TB1.[d7] = TB2.Cells(r, 2)
TB1.[d8] = TB2.Cells(r, 3)
TB1.[d9] = TB2.Cells(r, 4)
TB1.[d10] = TB2.Cells(r, 5)
TB1.[d11] = TB2.Cells(r, 6)
TB1.[d12] = TB2.Cells(r, 7)
TB1.[d13] = TB2.Cells(r, 8)
TB1.[d14] = TB2.Cells(r, 9)
If TB2.Cells(r, 11) <> "" Then
TB1.[d15] = TB2.Cells(r, 10)
TB1.[d15].Hyperlinks.Add Anchor:=TB1.[d15], Address:="mailto:" & TB2.Cells(r, 10)
End If
TB1.[d16] = TB2.Cells(r, 11)
TB1.[d17] = TB2.Cells(r, 12)
TB1.[d18] = TB2.Cells(r, 13)
TB1.[d19] = TB2.Cells(r, 14)
TB1.[d20] = TB2.Cells(r, 15)
TB1.[d21] = TB2.Cells(r, 16)
TB1.[d22] = TB2.Cells(r, 17)
TB1.[d23] = TB2.Cells(r, 18)
TB1.[d24] = TB2.Cells(r, 19)
TB1.[d25] = TB2.Cells(r, 20)
TB1.[d26] = TB2.Cells(r, 21)
TB1.[d27] = TB2.Cells(r, 22)
TB1.[d28] = TB2.Cells(r, 23)
TB1.[d29] = TB2.Cells(r, 24)
TB1.[d30] = TB2.Cells(r, 25)
TB1.[d31] = TB2.Cells(r, 26)
TB1.[d32] = TB2.Cells(r, 27)
TB1.[d33] = TB2.Cells(r, 28)
TB1.[d34] = TB2.Cells(r, 29)
TB1.[d35] = TB2.Cells(r, 30)
TB1.[d33] = TB2.Cells(r, 28)
TB1.Protect
Application.ScreenUpdating = True
End Sub
'Eintrag löschen
'Nur über das Andy-Menü erreichbar!
Sub EintragLöschen()
Dim TB1, TB2 As Worksheet
Set TB1 = ThisWorkbook.Worksheets(1)
Set TB2 = ThisWorkbook.Worksheets(2)
Application.ScreenUpdating = False
r = TB1.[H15]
frage = MsgBox("Soll der Eintrag:" & Chr(10) _
& Chr(10) & TB2.Cells(r, 1) & ", " & TB2.Cells(r, 2) _
& Chr(10) & Chr(10) & "gelöscht werden?", vbYesNo)
If frage = vbYes Then
TB2.Select
TB2.Unprotect
TB2.Rows(r).Delete
TB1.Select
DatenInTab1Eintragen
TB2.Protect
Else
MsgBox "Keine Löschung auf Benutzerwunsch"
End If
Application.ScreenUpdating = True
End Sub
Sub ListeSortieren_NN_VN()
Worksheets(2).Select
[a1].Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
Worksheets(1).Select
End Sub
Sub EingabeLoeschen()
[D6:D35].ClearContents
[d33].ClearContents
End Sub
Kann mir bitte jemand dabei helfen, ich weiss mir keinen Rat mehr.
Vielen Dank
Grüsse Andy