Msg Box, x aktivieren?
abu
habe im Netz einen Code gefunden mit dem ich einfach und schnell eine MsgBox mit drei Schaltflaechen aufrufen kann. Hatte hier schon mal gefragt ob man auch eine 4. Schaltflaeche hinzufuegen kann aber das ging nicht.
Jetzt wuere ich gerne Fragen ob man den Code anpassen kann, so dass das 'x' rechts oben aktiv ist und beim klick das Programm abbricht? Habs schon versucht aber das uebersteigt meine Kenntnisse bei weitem.
Gruss
abu
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