Hallo zusammen,
ich hab Schwierigkeiten mit meinem VBA Code.
Es geht darum, dass ich eine Excel Tabelle habe, in der durch eine Userform pro Zeile Sachen eingetragen werden sollen. Nachdem der „Eingabe“ Button getätigt wird öffnet sich durch SendKeys ein Hardware Programm. In diesem Fall handelt es sich um ein Unterschriften Pad. Dort soll drauf unterschrieben werden. Jetzt ist das Problem, dass nach dem die Unterschrift getätigt wurde und man auf „OK“ klickt, eine Fehlermeldung kommt: „Microsoft Excel kann die Daten nicht einfügen“. Grund dafür wird wohl der Blattschutz sein. Der wird aber vorher aufgehoben und erst nach dem SendKeys wieder aktiviert. Das Problem scheint darin zu liegen, dass Excel nicht auf die Unterschrifteneingabe wartet, sondern sofort nach dem Öffnen des Fensters zum Unterschreiben, den Blattschutz wieder aktiviert.
Hier der Code:
Private Sub CommandButton2_Click()
With ActiveSheet
.Unprotect Password:="test"
zeilenzahl = .Cells(Rows.Count, 2).End(xlUp).Row
.Cells(zeilenzahl + 1, 1).Value = TextBox_1
.Cells(zeilenzahl + 1, 2).Value = TextBox_2
.Cells(zeilenzahl + 1, 3).Value = TextBox_3
.Cells(zeilenzahl + 1, 4).Value = TextBox_4
.Cells(zeilenzahl + 1, 5).Value = TextBox_5
.Cells(zeilenzahl + 1, 6).Value = TextBox_6
.Cells(zeilenzahl + 1, 7).Value = TextBox_7
.Cells(zeilenzahl + 1, 9).Value = TextBox_8
.Cells(zeilenzahl + 1, 10).Value = TextBox_9
Unload Me
zeilenzahl = .Cells(Rows.Count, 2).End(xlUp).Row
.Cells(zeilenzahl, 8).Select
SendKeys "+{F8}", True
' If GetInputState() <> 0 Then
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="test"
' End If
End With
End Sub
Könnt ihr mir sagen wie ich das Problem lösen kann? Ich weiß einfach nicht mehr weiter.
Hab mir schon alles mögliche durchgelesen. Hab es mit DoEvents versucht und mit GetInputState, es hat aber nicht geklappt. Vielleicht hab ich es auch falsch benutzt. Ich kenn mich noch nicht so gut mit VBA aus.
Danke schonmal für eure Hilfe!
|