Msg Box mit 4 Schaltflächen?
abu
habe im Netz folgenden Code von Nepumuk gefunden der eine Msg Box mit 3 Schaltflächen erstellt.
Nun moechte ich aber 4 Schaltflächen oder gar 5 haben. Leider bekomme ichs nicht hin.
Ich vermute mal es liegt daran das es keine Konstante gibt die mehr als 3 Werte hat, bin mir aber nicht sicher.
Laesst sich das irgendwie umsetzen?
Beste Gruesse
Abu
Konstante Wert Beschreibung
vbOKOnly 0 Nur "OK" anzeigen.
vbOKCancel 1 "OK" und "Abbrechen" anzeigen.
vbAbortRetryIgnore 2 "Abbrechen", "Wiederholen" und "Ignorieren" anzeigen.
vbYesNoCancel 3 "Ja", "Nein" und "Abbrechen" anzeigen.
vbYesNo 4 "Ja", und "Nein" anzeigen.
vbRetryCancel 5 "Wiederholen" und "Abbrechen" anzeigen.
Option Explicit
'
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function SetTimer Lib "user32.dll" ( _
ByVal Hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimer As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" ( _
ByVal Hwnd As Long, _
ByVal nIDEvent As Long) As Long
Private Declare Function MessageBox Lib "user32.dll" Alias "MessageBoxA" ( _
ByVal Hwnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal wType As Long) As Long
Private Declare Function SendDlgItemMessage Lib "user32.dll" Alias "SendDlgItemMessageA" ( _
ByVal hDlg As Long, _
ByVal nIDDlgItem As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As String) As Long
Private Const TIMER_ID = 0
Private Const TIMER_ELAPSE = 25
Private Const WM_SETTEXT = &HC
Private Const GC_CLASSNAMEMSEXCEL = "XLMAIN"
Private Const GC_CLASSNAMEMSDIALOGS = "#32770"
Private lstrButtonCaption1 As String
Private lstrButtonCaption2 As String
Private lstrButtonCaption3 As String
Private lstrBoxTitel As String
Private llngHwnd As Long
Private Function MsgBox_Plus( _
ByVal strText As String, _
ByVal strTitle As String, _
ByVal strButtonText1 As String, _
Optional ByVal strButtonText2 As String, _
Optional ByVal strButtonText3 As String, _
Optional ByVal enmStyle As VbMsgBoxStyle) As Long
Dim lngResult As Long
lstrButtonCaption1 = strButtonText1
lstrButtonCaption2 = strButtonText2
lstrButtonCaption3 = strButtonText3
lstrBoxTitel = strTitle
If Val(Application.Version) > 9 Then
llngHwnd = Application.Hwnd
Else
llngHwnd = FindWindow(GC_CLASSNAMEMSEXCEL, Application.Caption)
End If
Call SetTimer(llngHwnd, TIMER_ID, TIMER_ELAPSE, AddressOf Set_Button_Text)
If lstrButtonCaption2 = "" And lstrButtonCaption3 = "" Then
lngResult = MessageBox(llngHwnd, strText, strTitle, vbOKOnly Or enmStyle)
ElseIf lstrButtonCaption2 "" And lstrButtonCaption3 = "" Then
lngResult = MessageBox(llngHwnd, strText, strTitle, vbYesNo Or enmStyle)
Else
lngResult = MessageBox(llngHwnd, strText, strTitle, vbAbortRetryIgnore Or enmStyle)
End If
If lngResult = 1 Or lngResult = 3 Or lngResult = 6 Then
MsgBox_Plus = 1
ElseIf lngResult = 4 Or lngResult = 7 Then
MsgBox_Plus = 2
Else
MsgBox_Plus = 3
End If
End Function
'
Private Sub Set_Button_Text()
Dim lngBox_hWnd As Long
Call KillTimer(llngHwnd, TIMER_ID)
lngBox_hWnd = FindWindow(GC_CLASSNAMEMSDIALOGS, lstrBoxTitel)
If lstrButtonCaption2 = "" And lstrButtonCaption3 = "" Then
Call SendDlgItemMessage(lngBox_hWnd, vbCancel, WM_SETTEXT, 0&, lstrButtonCaption1)
ElseIf lstrButtonCaption2 "" And lstrButtonCaption3 = "" Then
Call SendDlgItemMessage(lngBox_hWnd, vbYes, WM_SETTEXT, 0&, lstrButtonCaption1)
Call SendDlgItemMessage(lngBox_hWnd, vbNo, WM_SETTEXT, 0&, lstrButtonCaption2)
Else
Call SendDlgItemMessage(lngBox_hWnd, vbAbort, WM_SETTEXT, 0&, lstrButtonCaption1)
Call SendDlgItemMessage(lngBox_hWnd, vbRetry, WM_SETTEXT, 0&, lstrButtonCaption2)
Call SendDlgItemMessage(lngBox_hWnd, vbIgnore, WM_SETTEXT, 0&, lstrButtonCaption3)
End If
End Sub
Public Sub Aufruf()
Select Case MsgBox_Plus(strText:="Ich bin der Text", strTitle:="Titel", _
strButtonText1:="Hallo", strButtonText2:="Dirk", _
strButtonText3:="Dubai", enmStyle:=vbInformation)
Case 1
MsgBox "Button 1"
Case 2
MsgBox "Button 2"
Case 3
MsgBox "Button 3"
End Select
End Sub