MsgBox - Buttonbeschriftung, Icon ändern

[volti]

Hallo liebe Leserin, lieber Leser,

manchmal möchte man die Schaltflächen in seiner Msgbox individuell beschriften und vielleicht sogar das Icon ändern können.

Hierfür gibt es jede Menge Möglichkeiten. Zum Beispiel kann man die Messagebox-Funktion aus der Windows-API verwenden und hier die Buttons ändern.
Neben der Beschriftung können natürlich auch die Positionen und Größen der Buttons oder auch der Text und das Icon nachträglich (mehrfach) geändert werden, z.B. für einen Countdown usw..
Ein weites Feld.

Heute möchte ich hier aber nur eine Minmalversion unter Benutzung der Excel-MsgBox aufzeigen, die für eine einfache Buttonbeschriftung reicht....


Eine Möglichkeit, eine MsgBox mit vier Buttons zu erstellen wurde bereits hier aufgezeigt.
https://www.clever-excel-forum.de/Thread...genem-Icon


  MsgBoxExMin.xlsb (Größe: 40,77 KB / Downloads: 2)

Und nun viel Spaß beim Ausprobieren...

Code:

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 GetActiveWindow Lib "user32" () 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 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 mhTimer As LongPtr, mhIcon  As LongPtr, msBtns() As String

Function MsgboxEx(sText As String, _
         Optional ByVal iDlgStyle As Long, _
         Optional sCaption As String, _
         Optional sBtnText As String = "OK", _
         Optional sIcon As String) As String
  mhIcon = 0
  If sIcon <> "" Then
     mhIcon = Tabelle2.OLEObjects(sIcon).Object.Picture.Handle  ' <<<anpassen>>>
  End If
  
  msBtns = Split(",,," & sBtnText & ",,", ",")
  msBtns(1) = msBtns(3): msBtns(2) = IIf(UBound(msBtns) = 5, msBtns(1), msBtns(4))
  iDlgStyle = (iDlgStyle And &HFFFF8) Or (UBound(msBtns) - 5)

  mhTimer = SetTimer(0&, 0&, 10, AddressOf SetIconButtontext)
  MsgboxEx = Replace(msBtns(MsgBox(sText, iDlgStyle, sCaption)), "&", "")
End Function

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

  KillTimer 0&, mhTimer       ' Timer löschen,   Static-ID=20  &H170=STM_SETICON
  If mhIcon <> 0 Then SendDlgItemMessageA GetActiveWindow, 20, &H170, mhIcon, 0
  For iBtn = 1 To 5:  SetDlgItemTextA GetActiveWindow, iBtn, msBtns(iBtn): Next iBtn
End Sub

' ###############################
Private Sub CommandButton3_Click()
  MsgBox (MsgboxEx("Ein Test", vbInformation, "Meine Msgbox", "&Nehmen,&Ablehnen", "Freigericht"))
End Sub

_________
viele Grüße
Karl-Heinz