' Excel-MsgBox mit eigenem Button und Icon aus Ico-Datei versehen
Private Declare PtrSafe Function SetTimer Lib "user32" ( _
        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" ( _
        ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Private Declare PtrSafe Function FindWindowA Lib "user32" ( _
        ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SetDlgItemTextA Lib "user32" ( _
        ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
Private Declare PtrSafe Function LoadImageA Lib "user32" ( _
        ByVal hInst As LongPtr, ByVal lpsz As String, _
        ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPtr
Private Declare PtrSafe Function SendDlgItemMessageA Lib "user32" ( _
        ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _
        ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
        
Dim hTimer As LongPtr
Dim gsPfad  As String, gsCaption As String, sBtns(5) As String

Function MsgBoxEx(sText As String, Optional sBtnText As String = "OK", _
         Optional ByVal vbStyle As Long, Optional sCaption As String, _
         Optional sIconPfad As String) As String
  Dim sBtnArr() As String, iOffset As Integer
  
  gsCaption = sCaption: gsPfad = sIconPfad              ' Parameter global setzen
  
  vbStyle = vbStyle And &HFFFF8                         ' Buttonteil abtrennen
  sBtnArr = Split(sBtnText, ",")
  Select Case UBound(sBtnArr)                           ' Buttonstyle setzen
  Case 0: vbStyle = vbStyle Or vbOKOnly:   sBtns(2) = sBtnArr(0): iOffset = 1
  Case 1: vbStyle = vbStyle Or vbOKCancel: sBtns(1) = sBtnArr(0): sBtns(2) = sBtnArr(1)
  Case 2: vbStyle = vbStyle Or vbAbortRetryIgnore:
          sBtns(3) = sBtnArr(0): sBtns(4) = sBtnArr(1): sBtns(5) = sBtnArr(2)
  End Select
  
  hTimer = SetTimer(0&, 0&, 25, AddressOf SetIconButtontext)
  MsgBoxEx = Replace(sBtns(MsgBox(sText, vbStyle, gsCaption) + iOffset), "&", "")
End Function

Private Sub SetIconButtontext()
' Setzt die Button-Texte und das Icon individuell
  Dim hwnd As LongPtr, iBtn As Integer

  KillTimer 0&, hTimer                                  ' Timer löschen
  hwnd = FindWindowA("#32770", gsCaption)               ' Handle der DlgBox ermitteln
' &H170=STM_SETICON,  &H1=IMAGE_ICON,  40=Breite, Höhe,  &H10=LR_LOADFROMFILE
  If gsPfad <> "" Then _
  SendDlgItemMessageA hwnd, 20, &H170, LoadImageA(0&, gsPfad, &H1, 40, 40, &H10), 0
  For iBtn = 1 To 5: SetDlgItemTextA hwnd, iBtn, sBtns(iBtn): Next iBtn

End Sub


Sub Aufruftest()
  MsgBox (MsgBoxEx("Bitte wähle die Schlumpfaktion aus!", "Schlumpfe &aus,Schlumpfe &ein", _
          vbInformation, "Schlumpftest", "C:\ControlApp\schlumpf.ico"))
End Sub