Button ändert Farbe nicht

[seppi83]

Hallo zusammen,
ich habe einen Button erstellt der sich bei Click Rot färben soll und der Text soll sich ändern. Ausserdem wird bei Click ein Programm gestartet und auf dessen ende gewartet. Ist das Programm wieder beendet soll sich der Button wieder grün färben und der Text sich wieder ändern. Weiterhin wird der Inhalt der Zwischenablage in eine bestimmte Zelle eingefügt.

Nach langen suchen im Internet da ich ansich keine Ahnung von VBA habe ist folgender Quellcode herausgekommen, der soweit auch funktioniert lediglich das rot färben und die Textänderung bei Click funktioniert nicht bzw erst nachdem das externe Programm beendet ist wird der Button kurz rot und ich hab keine ahnung wieso.

Quellcode:


Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type

Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Const INFINITE = -1&

Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Const NORMAL_PRIORITY_CLASS = &H20&

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long


Sub ShellAndWait(ByVal Filename As String)
Dim RetVal As Long
Dim proc As PROCESS_INFORMATION
Dim StartInf As STARTUPINFO

StartInf.cb = Len(StartInf)

'Angegebenes Programm starten
RetVal = CreateProcessA(0&, Filename, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, StartInf, proc)

'Das eigene Programm anhalten, bis das fremde beendet wurde
RetVal = WaitForSingleObject(proc.hProcess, INFINITE)
RetVal = CloseHandle(proc.hProcess)
End Sub



Private Sub Einfügen()

Range("D21").Select
ActiveSheet.Paste

End Sub

Private Sub MessungStart()

CommandButton1.BackColor = vbGreen
CommandButton1.Caption = "Messung starten"

End Sub

Private Sub MessungLaeuft()

CommandButton1.BackColor = vbRed
CommandButton1.Caption = "Messung läuft"

End Sub

Private Sub Programm()
ShellAndWait "Notepad.exe"
End Sub

Private Sub CommandButton1_Click()
Call MessungLaeuft
Call Programm
Call Einfügen
Call MessungStart
End Sub

[wolfsgrube]

Color: RED.