|
Guten Tag in die Runde.
Ich möchte in einer Datei etwas einbauen, wozu ich mich aus einer anderen habe inspirieren lassen.
Es geht hierbei um das öffnen eines Formulars per Doppelklick in jeder Zelle einer bestimmten Spalte. Nun habe ich das Formular erstellt, den Makrotext zerpflückt und übernommen, was ich nach meinem Laienverständnis theoretisch benötige :-)Jedoch erhalte ich beim Doppelklick den Laufzeitfehler 424 und alles googeln, überlegen und mir raus schreiben was das Makro macht, lässt mich nicht den Fehler finden. Ich habe einfach kaum Ahnung davon :-(
Das Makro zum Ausführen ist:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 18 And Target.Value >= "" Then
Freigabemaske.Show
Cancel = True
End If
End Sub
Hinter dem Formular steht:
Private Sub aktuellesDatum_Change()
End Sub
Private Sub UserForm_Initialize()
'Rechnungspruefung aktiv?
If ActiveCell.Offset(0, 41).Value = "1" Then
CheckPruefung.Value = True
Else
CheckPruefung.Value = False
End If
'Aktivierung Rechnungsbuchung
If ActiveCell.Offset(0, 41).Value = "1" Then
CheckBox2.Enabled = True
SignGebucht.Enabled = True
Else
CheckBox2.Enabled = False
SignGebucht.Enabled = False
End If
'Rechnungsbuchung aktiv?
If ActiveCell.Offset(0, 48).Value = "1" Then
CheckBox2.Value = True
Else
CheckBox2.Value = False
End If
'Rechnungsprüfung aktiv/deaktiv?
If ActiveCell.Offset(0, 48).Value = "1" Then
CheckPruefung.Enabled = False
SignGeprueft.Enabled = False
Else
CheckPruefung.Enabled = True
SignGeprueft.Enabled = True
End If
'Rechnungbucher eingetragen DREI
If ActiveCell.Offset(0, 42).Value >= "" Then
SignGebucht.Value = ActiveCell.Offset(0, 42).Value
Else
SignGebucht.Value = ""
End If
'Freigebender Mitarbeiter eingetragen ZWEI
If ActiveCell.Offset(0, 47).Value >= "" Then
SignGeprueft.Value = ActiveCell.Offset(0, 47).Value
Else
SignGeprueft.Value = ""
End If
'Eintragenden Mitarbeiter? EINS
If ActiveCell.Offset(0, 45).Value >= "" Then
SignEingetragen.Value = ActiveCell.Offset(0, 45).Value
Else
SignEingetragen.Value = ""
End If
'ActiveCell.Offset(0, 42).Font.Color = RGB(0, 255, 0)
'ActiveCell.Offset(0, 44).Font.Color = RGB(0, 0, 255)
'Datum anzeigen
aktuellesDatum.Value = Date
'Datum eingetragen anzeigen
TextBoxRegDate.Value = ActiveCell.Offset(0, 44).Value
'Datum freigabe anzeigen
DateGeprueft.Value = ActiveCell.Offset(0, 46).Value
'Datum freigabe anzeigen
TextBox4.Value = ActiveCell.Offset(0, 43).Value
End Sub
Public Sub Daten1()
Dim j As Integer
Dim i As Integer
Dim k As Integer
j = ActiveCell.Row
k = ActiveCell.Column - 1
i = ActiveCell.Column - 1
If SignGebucht.Value = "" And CheckBox2.Value = True Then
MsgBox ("Bitte Kürzel eingeben")
Exit Sub
End If
If SignGeprueft.Value = "" And CheckPruefung.Value = True Then
MsgBox ("Bitte Kürzel eingeben")
Exit Sub
End If
'Rechnungsprüfung
If CheckPruefung.Value = True Then
'While k >= 1
' ActiveCell.Offset(0, -(k)).Font.Color = RGB(0, 0, 0)
' k = k - 1
'Wend
ActiveCell.Offset(0, 41).Value = "1"
Else
'While k >= 1
' ActiveCell.Offset(0, -(k)).Font.Color = RGB(255, 0, 0)
' k = k - 1
'Wend
ActiveCell.Offset(0, 41).Value = "0"
End If
ActiveCell.Offset(0, 42).Value = SignGebucht.Value
'RechnungsBuchung
'If CheckBox2.Value = True Then
'While k >= 1
' ActiveCell.Offset(0, -(k)).Font.Color = RGB(0, 0, 0)
' k = k - 1
' Wend
'ActiveCell.Offset(0, 48).Value = "1"
'Else
' While k >= 1
' ActiveCell.Offset(0, -(k)).Font.Color = RGB(255, 0, 0)
' k = k - 1
'Wend
'ActiveCell.Offset(0, 48).Value = "0"
'End If
'Speicherung eintragender Mitarbeiter
ActiveCell.Offset(0, 45).Value = SignEingetragen.Value
'Speicherung Datum Anlage
If ActiveCell.Offset(0, 44).Value = "" Then
ActiveCell.Offset(0, 44).Value = aktuellesDatum.Value
Else
End If
'Speicherung prüfender Mitarbeiter
ActiveCell.Offset(0, 47).Value = SignGeprueft.Value
'Speicherung Datum Pruefung
If ActiveCell.Offset(0, 46).Value = "" And CheckPruefung.Value = True Then
ActiveCell.Offset(0, 46).Value = aktuellesDatum.Value
Else
ActiveCell.Offset(0, 46).Value = ""
ActiveCell.Offset(0, 47).Value = ""
End If
'Speicherung Datum Rechnung
If ActiveCell.Offset(0, 43).Value = "" And CheckBox2.Value = True Then
ActiveCell.Offset(0, 43).Value = aktuellesDatum.Value
Else
ActiveCell.Offset(0, 43).Value = ""
ActiveCell.Offset(0, 42).Value = ""
End If
'Ausgabe
ActiveCell.Offset(0, 0).Value = "" & ActiveCell.Offset(0, 45).Value & " - " & ActiveCell.Offset(0, 44).Value & " I " & ActiveCell.Offset(0, 47).Value & " - " & ActiveCell.Offset(0, 46).Value & " I " & ActiveCell.Offset(0, 42).Value & " - " & ActiveCell.Offset(0, 43).Value
Unload Me
End Sub
Private Sub CommandButton1_Click()
Call Daten1
End Sub
Kann mir hier bitte jemand weiterhelfen? :-(
|