Hallo Siegfried,
den Text in MsgBox-Buttons änderst du so:
Option Explicit
Private Declare PtrSafe Function FindWindowA Lib "user32.dll" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SetTimer Lib "user32.dll" ( _
ByVal hwnd As LongPtr, _
ByVal nIDEvent As LongPtr, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32.dll" ( _
ByVal hwnd As LongPtr, _
ByVal nIDEvent As LongPtr) As Long
Private Declare PtrSafe Function MessageBoxA Lib "user32.dll" ( _
ByVal hwnd As LongPtr, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal wType As Long) As Long
Private Declare PtrSafe Function SendDlgItemMessageA Lib "user32.dll" ( _
ByVal hDlg As LongPtr, _
ByVal nIDDlgItem As Long, _
ByVal wMsg As Long, _
ByVal wParam As LongPtr, _
ByVal lParam As String) As LongPtr
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 LongPtr
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 enmResult As VbMsgBoxResult
lstrButtonCaption1 = strButtonText1
lstrButtonCaption2 = strButtonText2
lstrButtonCaption3 = strButtonText3
lstrBoxTitel = strTitle
Call SetTimer(Application.hwnd, TIMER_ID, TIMER_ELAPSE, AddressOf SetButtonText)
If lstrButtonCaption2 = "" And lstrButtonCaption3 = "" Then
enmResult = MessageBoxA(llngHwnd, strText, strTitle, vbOKOnly Or enmStyle)
ElseIf lstrButtonCaption2 "" And lstrButtonCaption3 = "" Then
enmResult = MessageBoxA(llngHwnd, strText, strTitle, vbYesNo Or enmStyle)
Else
enmResult = MessageBoxA(llngHwnd, strText, strTitle, vbAbortRetryIgnore Or enmStyle)
End If
If enmResult = vbOK Or enmResult = vbYes Or enmResult = vbAbort Then
MsgBoxPlus = 1
ElseIf enmResult = vbNo Or enmResult = vbRetry Then
MsgBoxPlus = 2
Else
MsgBoxPlus = 3
End If
End Function
Private Sub SetButtonText()
Dim lngptrBoxHwnd As LongPtr
Call KillTimer(Application.hwnd, TIMER_ID)
lngptrBoxHwnd = FindWindowA(GC_CLASSNAMEMSDIALOGS, lstrBoxTitel)
If lstrButtonCaption2 = "" And lstrButtonCaption3 = "" Then
Call SendDlgItemMessageA(lngptrBoxHwnd, vbCancel, WM_SETTEXT, 0&, lstrButtonCaption1)
ElseIf lstrButtonCaption2 "" And lstrButtonCaption3 = "" Then
Call SendDlgItemMessageA(lngptrBoxHwnd, vbYes, WM_SETTEXT, 0&, lstrButtonCaption1)
Call SendDlgItemMessageA(lngptrBoxHwnd, vbNo, WM_SETTEXT, 0&, lstrButtonCaption2)
Else
Call SendDlgItemMessageA(lngptrBoxHwnd, vbAbort, WM_SETTEXT, 0&, lstrButtonCaption1)
Call SendDlgItemMessageA(lngptrBoxHwnd, vbRetry, WM_SETTEXT, 0&, lstrButtonCaption2)
Call SendDlgItemMessageA(lngptrBoxHwnd, vbIgnore, WM_SETTEXT, 0&, lstrButtonCaption3)
End If
End Sub
Public Sub Aufruf()
Select Case MsgBoxPlus(strText:="Darstellung der Schmerzeinschätzung?" & vbLf & _
"Über (NRS) oder Über (BESD)", strTitle:="Titel", _
strButtonText1:="NRS", strButtonText2:="BESD", _
strButtonText3:="Abbrechen", enmStyle:=vbExclamation)
Case 1
MsgBox "Button 1"
Case 2
MsgBox "Button 2"
Case 3
MsgBox "Button 3"
End Select
End Sub
Gruß
Nepumuk