Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1396to1400
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro mit API-MsgBox beenden

Makro mit API-MsgBox beenden
25.12.2014 22:19:03
Golem
Hallo Excel-Fachleute,
ich benötige wieder Eure Hilfe.
Mit folgendem Makro positioniere ich eine API-MsgBox auf einem Excel-Fenster ( nicht von mir, nur angepasst ).
Option Explicit
' Entfernt eine Hook-Prozedur in einer Hook-Kette von der installierten SetWindowsHookEx Funktion.
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
' Wird die Identität des aktuell ausgeführten Thema zurückkehren.
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
' Installiert eine anwendungsdefinierte Hook-Prozedur in eine Hook-Kette.
Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) _
As Long
' Die API-Funktion SetWindowPos positioniert, zeigt und versteckt Fenster.
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) _
As Long
' Deklaration: Globale Form API-Konstanten
Private Const SWP_NOSIZE As Long = &H1 ' verhindert, dass das Fenster eine neue Größe bekommt.
Private Const SWP_NOZORDER As Long = &H4 ' verhindert, dass die Z-Order-Position verändert wird.
' Hakentypen, um ein neues Fenster zu erkennen
Private Const WH_CBT = 5 ' Installiert eine Hook-Prozedur.....
Private Const HCBT_ACTIVATE = 5 ' Das System ist dabei, ein Fenster zu aktivieren....
' Griff in die Hook-Prozedur
Private hHook As Long
' Position
Private msgbox_x As Long
Private msgbox_y As Long
Sub Pos_API_MsgBox()
Dim fb As Integer
fb = ActiveWindow.Width 'gesamte Fensterbreite in Pixel.....
MsgBoxPos " Sollen die Umsätze weiter eingelesen werden ?", vbYesNo _
"Für Abbruch bitte Nein betätigen", _
(fb + 313) / 2 - (305 / 2), 430 ' halbe Fensterbreite minus halbe MsgBox, von oben 430 Pixel.....
End Sub
Public Sub MsgBoxPos(strPromt As String, _
vbButtons As VbMsgBoxStyle, _
strTitle As String, _
xPos As Long, _
yPos As Long)
' Position speichern
msgbox_x = xPos
msgbox_y = yPos
' Installiert eine anwendungsdefinierte Hook-Prozedur in einer Hook-Kette.
hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, 0, GetCurrentThreadId)
' Run MessageBox
MsgBox strPromt, vbButtons, strTitle
End Sub

Private Function MsgBoxHookProc(ByVal lMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
If lMsg = HCBT_ACTIVATE Then
' Position ändern
SetWindowPos wParam, 0, msgbox_x, msgbox_y, 0, 0, SWP_NOSIZE + SWP_NOZORDER
' SetWindowPos wParam, 0, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
' SetWindowPos wParam, 0, x, y, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
' Lassen Sie den Haken
UnhookWindowsHookEx hHook
End If
MsgBoxHookProc = False
End Function

Nach einem jeweiligen einzelnen Schleifendurchlauf , soll durch die Betätigung der der Ja-Taste, ein weiterer Schleifendurchlauf
erfolgen ( bis zum Schleifende lngEnd = Range("I38") )
Durch die Betätigung der Nein-Taste möchte ich mit G0To DispFehler nach jedem Schleifendurchlauf
den Code beenden können.
Private Sub CommandButton55_Click()
Dim strPath As String
Dim objWorkbook As Workbook
Dim fso As Object
Dim byWert As Byte
' For-Next-Schleife mit numerische Variablen.....
Dim lngIndex As Long
' Start-, Endwert und Schritt variabel.....
Dim lngStart As Long
Dim lngEnd As Long
'Dim lngStep As Long
' Bei einer On Error-Anweisung, führt jeder Laufzeitfehle
' zur Anzeige einer Fehlermeldung und zum Beenden des Programms.
' GoTo aktiviert die Fehlerbehandlungsroutine.
On Error GoTo DispFehler
' Mit dem FSO-Modell können Informationen zu Ordnern abgerufen werden,
' z. B. der Name oder das Erstellungs- bzw. Änderungsdatum
' und auch die Anzahl der Dateien im Ordner.
' Mit der CreateObject-Methode, wird ein FileSystemObject-Objekt erstellt.
Set fso = CreateObject("Scripting.FileSystemObject")
If Range("D39") = False Then _
lngStart = Range("F38")
lngEnd = Range("I38")
'If Range("D39") = True Then _
'Range("F38") = ""
'Rang'lngStart = 1
'lngEnd = fso.GetFolder(ActiveWorkbook.Path & "\Umsatz ET").Files.Count - 8  '  _
mit GetFolder, wird ein Ordner aufgerufen.....
For lngIndex = lngStart To lngEnd
' Die Bildschirmaktualisierung wird abgeschaltet.
' Das verhindert einen flackernden Bildschirm und beschleunigt damit den VBA-Code.
Application.ScreenUpdating = False
strPath = FindFile(ActiveWorkbook.Path, CStr("Whn " & lngIndex & ".xlsm"))
If strPath  vbNullString Then
Set objWorkbook = Workbooks.Open(Filename:=strPath)
Else
MsgBox "Datei nicht" & vbCrLf & "gefunden!", vbExclamation, "        Es tut mir leid!"
End If
' Application.Run führt ein VBA-Makro aus. Der Makroname-Parameter besteht
' aus Dateiname mit Erweiterung, Code Name Tabellenblatt und Button.
Application.Run "'Whn " & lngIndex & ".xlsm" & "'!Tabelle1.CommandButton1_Click"
' DisplayAlerts, was soviel heißt wie Warnung anzeigen.
' Wird dies auf false gesetzt, werden Warnungen unterdrück.
' Der Benutzer wird nicht aufgefordert, Änderungen zu speichern.
Application.DisplayAlerts = False
objWorkbook.Close True ' Datei wird gespeichert, während sie geschlossen wird.....
'If MsgBox("Weiter im Code?", vbYesNo)  vbYes Then
Pos_API_MsgBox
If byWert  1 Then
GoTo DispFehler   ' mit DispFehler wird der Code abgebrochen.....
End If
Next lngIndex
DispFehler:
Application.DisplayAlerts = True    ' DisplayAlerts wird wieder eingeschaltet.....
Application.ScreenUpdating = True   ' Die Bildschirmaktualisierung wird wieder  _
eingeschaltet.....
End Sub

Mit der normalen MsgBox funktioniert der Weiterlauf und das Beenden mit folgender Abfrage:
'If MsgBox("Weiter im Code?", vbYesNo) vbYes Then
If byWert 1 Then
GoTo DispFehler ' mit DispFehler wird der Code abgebrochen.....
End If
einwandfrei.
Mit der API-MsgBox habe ich es wie folgt versucht:
Pos_API_MsgBox
If byWert 1 Then
GoTo DispFehler ' mit DispFehler wird der Code abgebrochen.....
End If
Aber damit kann ich nur ein Beenden erreichen, keinen Weiterlauf.
Für evtl. Tipps oder Anregungen schon mal besten Dank!
Werner

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro mit API-MsgBox beenden
26.12.2014 17:06:04
Mullit
Hallo,
klar wie Kloßbrühe, da die Standard-Msgbox als Function mit Rückgabewert aufgerufen wird, mußt Du auch Deine Api-Aufrufe in Funktionen mit Rückgabewert umschreiben:
Option Explicit

' Entfernt eine Hook-Prozedur in einer Hook-Kette von der installierten SetWindowsHookEx Funktion. 
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long

' Wird die Identität des aktuell ausgeführten Thema zurückkehren. 
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

' Installiert eine anwendungsdefinierte Hook-Prozedur in eine Hook-Kette. 
Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) _
As Long

' Die API-Funktion SetWindowPos positioniert, zeigt und versteckt Fenster. 
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) _
As Long

' Deklaration: Globale Form API-Konstanten 
Private Const SWP_NOSIZE As Long = &H1 ' verhindert, dass das Fenster eine neue Größe bekommt. 
Private Const SWP_NOZORDER As Long = &H4 ' verhindert, dass die Z-Order-Position verändert wird. 

' Hakentypen, um ein neues Fenster zu erkennen 
Private Const WH_CBT = 5 ' Installiert eine Hook-Prozedur..... 
Private Const HCBT_ACTIVATE = 5 ' Das System ist dabei, ein Fenster zu aktivieren.... 

' Griff in die Hook-Prozedur 
Private hHook As Long

' Position 
Private msgbox_x As Long
Private msgbox_y As Long

Private Function Pos_API_MsgBox() As Integer
Dim fb As Integer

fb = ActiveWindow.Width 'gesamte Fensterbreite in Pixel..... 

Pos_API_MsgBox = MsgBoxPos(" Sollen die Umsätze weiter eingelesen werden ?", vbYesNo, _
 "Für Abbruch bitte Nein betätigen", _
(fb + 313) / 2 - (305 / 2), 430) ' halbe Fensterbreite minus halbe MsgBox, von oben 430 Pixel..... 

End Function

Private Function MsgBoxPos(strPromt As String, _
              vbButtons As VbMsgBoxStyle, _
              strTitle As String, _
              xPos As Long, _
              yPos As Long) As Integer
 
' Position speichern 
    msgbox_x = xPos
    msgbox_y = yPos
 
' Installiert eine anwendungsdefinierte Hook-Prozedur in einer Hook-Kette. 
    hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, 0, GetCurrentThreadId)
 
' Run MessageBox 
  MsgBoxPos = MsgBox(strPromt, vbButtons, strTitle)
    
End Function

Private Function MsgBoxHookProc(ByVal lMsg As Long, _
                                ByVal wParam As Long, _
                                ByVal lParam As Long) As Long
                                
    If lMsg = HCBT_ACTIVATE Then
    
        ' Position ändern 
        SetWindowPos wParam, 0, msgbox_x, msgbox_y, 0, 0, SWP_NOSIZE + SWP_NOZORDER
         
        ' SetWindowPos wParam, 0, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE 
        ' SetWindowPos wParam, 0, x, y, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE 
 
        ' Lassen Sie den Haken 
        UnhookWindowsHookEx hHook
        
    End If
 
    MsgBoxHookProc = False
    
End Function

Public Sub aufruf()
  If Pos_API_MsgBox = vbYes Then
     MsgBox "Weiter geht's..."
  Else
     MsgBox "Abbruch"
  End If
End Sub


VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel



Code erstellt und getestet in Office 12

Gruß,

Anzeige
AW: Makro mit API-MsgBox beenden
27.12.2014 19:24:24
Golem
Hallo Mullit!
Ich habe erst gerade gesehen, dass Du auf meine Anfrage geantwortet hast.
Entschuldige bitte meine späte Rückantwort!
Ich habe es schon vermutet, dass meine API_MsgBox keine Rückgabewerte liefert.
Aber bisher habe ich nicht herausgefunden, wie ich dieses Problem lösen kann.
Deshalb einen schönen Dank für Deine Mitteilung.
Ich werde Deine Lösung ausprobieren und danach mich wieder melden.
Schöne Grüße
Werner

AW: Makro mit API-MsgBox beenden
28.12.2014 16:07:28
Golem
Hallo Mullit!
Dank Deiner Hilfe, habe ich es hinbekommen, dass mit der API-MsgBox
der Code angehalten bzw. weiterlaufen kann.
Schöne Grüße
Werner
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige