AW: msg box mit 3 auswahlmöglichkeiten
09.07.2014 14:04:54
Nepumuk
Hallo,
das geht schon. Beispiel:
Option Explicit
Private Declare Function FindWindowA Lib "user32.dll" ( _
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 MessageBoxA Lib "user32.dll" ( _
ByVal Hwnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal wType As Long) As Long
Private Declare Function SendDlgItemMessageA Lib "user32.dll" ( _
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 MsgBoxPlus( _
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 = FindWindowA(GC_CLASSNAMEMSEXCEL, Application.Caption)
End If
Call SetTimer(llngHwnd, TIMER_ID, TIMER_ELAPSE, AddressOf SetButtonText)
If lstrButtonCaption2 = "" And lstrButtonCaption3 = "" Then
lngResult = MessageBoxA(llngHwnd, strText, strTitle, vbOKOnly Or enmStyle)
ElseIf lstrButtonCaption2 <> "" And lstrButtonCaption3 = "" Then
lngResult = MessageBoxA(llngHwnd, strText, strTitle, vbYesNo Or enmStyle)
Else
lngResult = MessageBoxA(llngHwnd, strText, strTitle, vbAbortRetryIgnore Or enmStyle)
End If
If lngResult = 1 Or lngResult = 3 Or lngResult = 6 Then
MsgBoxPlus = 1
ElseIf lngResult = 4 Or lngResult = 7 Then
MsgBoxPlus = 2
Else
MsgBoxPlus = 3
End If
End Function
Private Sub SetButtonText()
Dim lngBox_hWnd As Long
Call KillTimer(llngHwnd, TIMER_ID)
lngBox_hWnd = FindWindowA(GC_CLASSNAMEMSDIALOGS, lstrBoxTitel)
If lstrButtonCaption2 = "" And lstrButtonCaption3 = "" Then
Call SendDlgItemMessageA(lngBox_hWnd, vbCancel, WM_SETTEXT, 0&, lstrButtonCaption1)
ElseIf lstrButtonCaption2 <> "" And lstrButtonCaption3 = "" Then
Call SendDlgItemMessageA(lngBox_hWnd, vbYes, WM_SETTEXT, 0&, lstrButtonCaption1)
Call SendDlgItemMessageA(lngBox_hWnd, vbNo, WM_SETTEXT, 0&, lstrButtonCaption2)
Else
Call SendDlgItemMessageA(lngBox_hWnd, vbAbort, WM_SETTEXT, 0&, lstrButtonCaption1)
Call SendDlgItemMessageA(lngBox_hWnd, vbRetry, WM_SETTEXT, 0&, lstrButtonCaption2)
Call SendDlgItemMessageA(lngBox_hWnd, vbIgnore, WM_SETTEXT, 0&, lstrButtonCaption3)
End If
End Sub
Public Sub Aufruf()
Select Case MsgBoxPlus(strText:="Ich bin der Text", strTitle:="Titel", _
strButtonText1:="Button 1", strButtonText2:="Button 2", _
strButtonText3:="Button 3", enmStyle:=vbInformation)
Case 1
MsgBox "Button 1"
Case 2
MsgBox "Button 2"
Case 3
MsgBox "Button 3"
End Select
End Sub
Die Beschränkung liegt in den Buttons, denn du kannst keinen langen Text unterbringen. Natürlich könnte ich per API-Funktion diese verbreitern und entsprechend verschieben, ist mir aber zu viel Aufwand, denn das selbe mit einem Userform benötigt nur einen Bruchteil des Codes.
Gruß
Nepumuk