Microsoft Excel

Herbers Excel/VBA-Archiv

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen

Userformknopfdruck im Makro definieren

nach unten

Betrifft: Userformknopfdruck im Makro definieren von: JW Wickert
Geschrieben am: 09.09.2020 09:11:33

https://www.herber.de/bbs/user/140141.xlsm

Hallo liebe Excel Freunde,

ich würde gerne ein Userform in meine Makros einbinden.
Da ich im Endeffekt das gleiche Userform in schwach abgeänderter Variante für 20 verschiedene Makros brauche, würde ich gerne ein einziges Useform verwenden und die aktionen, die geschehen sollen nicht im Userform, sondern im Makro definieren.

Ich hab das ganze mal beispielhaft in der beigefügten Datei angerissen. Wie man sehen kann, möchte ich über eine IF-Abfrage die einzelnen Aktionen steuern. Im Userform selbst haben die knöpfe dann keine eigenes Makro...

Wenn ich die Aktionen im Userform selbst steuere, müsste ich für jedes einzige Makro ein Userform machen und das wäre sehr Zeitaufwendig.

Liebe Grüße

JW

nach oben  nach unten

Betrifft: AW: Userformknopfdruck im Makro definieren
von: Daniel
Geschrieben am: 09.09.2020 09:53:24

HI
so wie du das vorhast, geht das nicht.
du kannst nicht extern abfragen, ob ein bestimmter Button in der Userform gedrückt wurde
für das was du zeigst, kannst du auch einfacher die Messagebox verwenden, wenn dir maximal 3 Auswahlbuttons (ja/ok, nein, abbrechen) ausreichen:
Private Sub CommandButton1_Click()
Select Case MsgBox("Sind sie sicher, dass die Prüfstand x kalibrieren möchten?", vbQuestion +  _
vbOKCancel, "Deine Überschrift")
    Case vbOK
        Cells(1, 1) = 1
    Case Else
End Select

End Sub


nach oben  nach unten

Betrifft: AW: Userformknopfdruck im Makro definieren
von: JW Wickert
Geschrieben am: 09.09.2020 10:24:48

Vielen Dank Daniel.
Das ist perfekt so.
Viel einfacher als das was ich geplant habe und auch viel leichter individualisierbar.

MfG

JW

nach oben  nach unten

Betrifft: AW: Userformknopfdruck im Makro definieren
von: volti
Geschrieben am: 09.09.2020 10:13:05

Hallo JW,

ergänzend zu Daniel's Vorschlag, das mit einer Messagebox zu machen, kann ich Dir nachfolgenden Code empfehlen.
Wenn Dir drei Button in einer MsgBox reichen würden, Du sie aber gern individuell beschriften möchtest, wäre das ein recht guter Weg.

 
[Cc][+][-]
 
Option Explicit

Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, _
        ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, _
        ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare PtrSafe Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" ( _
        ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function MessageBox Lib "user32" Alias "MessageBoxA" ( _
        ByVal hwnd As LongPtr, ByVal lpText As String, ByVal lpCaption As String, _
        ByVal wType As Long) As Long
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" ( _
        ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, _
        ByVal dwThreadId As Long) As LongPtr
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _
        ByVal hhk As LongPtr) As Long
Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" ( _
        ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function GetWindowRect Lib "user32" ( _
        ByVal hwnd As LongPtr, lpRect As RECT) As Long
Private Declare PtrSafe Function GetSystemMetrics Lib "user32" ( _
        ByVal nIndex As Long) As Long
         
Type MSGBOX_STRUCT
  hHook      As LongPtr
  hwndOwner  As LongPtr
  vbBtnStyle As Long
  vbDlgStyle As Long
  x          As Long
  y          As Long
  sBtns()    As String
End Type
Dim tMsg As MSGBOX_STRUCT

Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Type POINTAPI
  x As Long
  y As Long
End Type

Private Const GWL_HINSTANCE = (-6)
Private Const GWL_STYLE = (-16)
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
Private Const HWND_TOPMOST = -1


Function MsgBoxHookProc(ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As Long) As LongPtr
'Funktion versieht die Buttons mit neuen Texten
'Je nach Anzahl gewünschter Buttons wird eine MSGBOX mit passendem Style aufgemacht
'Schalter: vbMsgBoxSetForeground, vbSystemModal, vbMsgBoxHelpButton, vbDefaultButton1,2,3,4
 Dim tRect As RECT, lPos As Long

'Funktion versieht die Buttons mit neuen Texten
'Je nach Anzahl gewünschter Buttons wird eine MsgBox mit passendem Style aufgemacht
'Schalter: vbMsgBoxSetForeground, vbSystemModal, vbMsgBoxHelpButton, vbDefaultButton1,2,3,4
 If uMsg = 5 Then
   With tMsg
    If .vbDlgStyle >= vbMsgBoxSetForeground Then _
    SetWindowPos wParam, HWND_TOPMOST, 0, 0, 0, 0, &H3 '&H3=SWP_NOMOVE Or SWP_NOSIZE
    SetDlgItemText wParam, 1, .sBtns(0)
    SetDlgItemText wParam, 2, .sBtns(1)
    SetDlgItemText wParam, 3, .sBtns(0)
    SetDlgItemText wParam, 4, .sBtns(1)
    SetDlgItemText wParam, 5, .sBtns(2)
    
    If .x > 0 And .y > 0 Then
     GetWindowRect wParam, tRect
     lPos = GetSystemMetrics(SM_CXSCREEN) - (tRect.Right - tRect.Left)
     If .x > lPos Then .x = lPos
     lPos = GetSystemMetrics(SM_CYSCREEN) - (tRect.Bottom - tRect.Top)
     If .y > lPos Then .y = lPos
     SetWindowPos wParam, 0, .x, .y, 0, 0, &H1 '&H1=SWP_NOSIZE
    End If
    
    UnhookWindowsHookEx .hHook
   End With
 End If
 
 MsgBoxHookProc = False

End Function


Public Function MsgBoxEx( _
       MsgTxt As String, _
       sTitle As String, _
       Optional sButtons As String = "OK", _
       Optional vbIcon As Long, _
       Optional bParent As Boolean, _
       Optional ByVal x As Long, _
       Optional ByVal y As Long) As String

'Funktion gibt den Text zum gedrückten Button zurück
 With tMsg
  .x = x: .y = y
  
  .sBtns = Split(sButtons & ",,", ",")
  .vbDlgStyle = (vbIcon And &HFFFF8)
  .vbBtnStyle = UBound(.sBtns()) - 2
  
  If bParent Then
     .hwndOwner = GetDesktopWindow() 'MsgBox unabhängig von Excel
  Else
     .hwndOwner = Application.hwnd   'MsgBox an Excel gebunden
  End If
  
  .hHook = SetWindowsHookEx(5, AddressOf MsgBoxHookProc, _
           GetWindowLongPtr(Application.hwnd, GWL_HINSTANCE), GetCurrentThreadId())
  
  Select Case MessageBox(.hwndOwner, Replace(MsgTxt, "", vbLf), sTitle, .vbBtnStyle Or .vbDlgStyle)
  Case vbOK, vbYes, vbAbort:    x = 0
  Case vbNo, vbRetry, vbCancel: x = 1
  Case vbIgnore:                x = 2
  End Select
  
  MsgBoxEx = Replace(.sBtns(x), "&", "")    'Shortkey-Zeichen entfernen
 End With

End Function



'##### Beispiele #####
'Diese Sub's sind zum Testen
'Es können 1,2 oder 3 Buttons angezeigt werden => kommagetrennt angeben
'Wenn keine angegeben sind, werden die Originaltexte (deutsch) laut Style-Vorgabe verwendet
'& vor einem Buchstaben stellt die Shortcuttaste dar z.B. Alt-S usw.
' stellt einen Zeilenumbruch dar (vbLf)
'Die beiden letzten optionalen Parameter sind für die Positionierung der MsgBox
'Zurückgegeben wird keine Nummer, sondern der Buttontext des geklickten Buttons


Sub MeinMsgBoxTest()
 Select Case MsgBoxEx("Sind Sie sicher, dass Sie die Kablibration von SRV 3starken möchten?!", "Auswahl", _
            "&Kalibrieren,S&chließen", vbQuestion)
 Case "Kalibrieren": MsgBox "Kalibrieren gewählt"
 Case "Schließen":   MsgBox "Schließen gewählt"
 End Select
End Sub

Sub MeinMsgBoxTest3()
  MsgBox MsgBoxEx("Hello World!", "MeineMsgbox")
End Sub

Sub MeinMsgBoxTest4()
  MsgBox MsgBoxEx("Hello World,Ich bin jetzt oben links!", "MeineMsgbox", , , , 10, 10)
End Sub
____________________
viele Grüße aus Freigericht
Karl-Heinz


nach oben  nach unten

Betrifft: AW: Userformknopfdruck im Makro definieren
von: Daniel
Geschrieben am: 09.09.2020 10:18:09

HI Karl-Heinz
nichts für ungut, aber wäre es dann nicht einfacher, eine Userform zu erstellen und bei Buttonklick eine bestimmte Nummer in eine projektweit gültige Variable zu schreiben, welche man dann wie bei der Messagebox abfragen kann?
Das was du da zeigst, scheint mir doch sehr aufwendig.
Gruß Daniel

nach oben  nach unten

Betrifft: AW: Userformknopfdruck im Makro definieren
von: volti
Geschrieben am: 09.09.2020 10:42:35

Hi Daniel,

ja das ist aufwendig, da gebe ich Dir recht.
Aber es ist ja fertig und damit für den Nutzer wieder einfach.

viele Grüße
KH

nach oben  nach unten

Betrifft: AW: Userformknopfdruck im Makro definieren
von: Daniel
Geschrieben am: 09.09.2020 10:48:05

ich vertrete halt die Ansicht, dass man im professionellen Umfeld nur den Quellcode verwenden sollte, den man auch verstanden hat, zumindest dann, wenn man diesen Quellcode aus anonymer Quelle bezieht und dafür gegenüber seinem Kunden so verantwortlich ist, als hätte man ihn selbst geschrieben.
Gruß Daniel

nach oben  nach unten

Betrifft: AW: Userformknopfdruck im Makro definieren
von: volti
Geschrieben am: 09.09.2020 11:02:31

Ja Daniel,
auch da bin ich bei Dir und für mich selbst gilt das auch, dass ich selbst Beispiele von anderen immer nachvollziehe.

- Es ist nur ein Vorschlag...
- Der Fragesteller weist VB gut aus und woher weißt Du, dass er es nicht versteht.
- Ich habe im Lauf der Zeit den Eindruck gewonnen, dass nicht immer alle Fragenden Ihnen überlassenden Code komplett verstanden haben, sondern ihn einfach nur nutzen.

viele Grüße
KH

nach oben  nach unten

Betrifft: AW: Userformknopfdruck im Makro definieren
von: Daniel
Geschrieben am: 09.09.2020 11:22:19

es steht natürlich jedem frei, solchen Code zu nutzen oder es zu lassen.
ich bezog mich da auf deine Aussage
"Aber es ist ja fertig und damit für den Nutzer wieder einfach."
und nicht auf die Fähigkeiten des Fragestellers.

wenn ich die Fähigkeit eines Fragestellers einschätzen soll, dann ist die Frage selbst oft das bessere Merkmal als die Selbsteinschätzung des Fragestellers.
Letztendlich stellt sich immer auch die Frage, wo sind die verwendeten Methoden dokumentiert und können im zweifelfall nachgeschlagen werden. Somit ist alles "schwierig", was nicht über F1 mit einer Hilfeseite verlinkt ist.
Gruß Daniel