Schließen des Basisfensters

Hallo Wissende
ich programmiere gerade eine VBA-Anwendung, die - für den Anwender - ausschließlich in einer Userform stattfindet. Das Hauptfenster braucht es nicht.
Konkret passiert dort lediglich über Open_Workbooks eine Prüfung, ob alle benötigten Datenbanken erreichbar sind. Dann wird das Fenster minimiert und die Userform wird aufgerufen.
Ich habe eine Sub "ProgrammBeenden", die in Aktion tritt, wenn der Anwender in der UserForm auf das rote Kreuz klickt (oder wenn es gar nicht so weit kommt, weil die Datenbanken nicht erreichbar sind). In diesem Programm werden einige Werte wieder zurückgesetzt, die DAO-Verbindung getrennt und - jetzt kommen wir zum Thema - das Anwendungsfenster geschlossen.
Ich möchte gern, dass es im Normalbetrieb wie folgt funktioniert:
- wenn die geöffnete Instanz die einzige Excel-Instanz ist: Excel schließen
- wenn weitere Excel-Instanzen offen sind: Die aktuelle Instanz schließen und alle anderen unberührt lassen
Hinweis: Die Anwendung dient nur der "Fernsteuerung", es sollen keine Änderungen gespeichert werden.
Der Nicht-Normalbetrieb ist daran erkennbar, dass die Anwendung nicht Archiv.xlsm handelt. (Während der Entwicklung nehme ich andere Dateinamen, und da soll er gar nichts schließen, damit ich relativ einfach an den VBA-Code komme)
Ich habe also folgenden Schnipsel ganz ans Ende meiner Beenden-Sub geschrieben:


If ActiveWorkbook.Name = "Archiv.xlsm" Then
If Workbooks.Count = 1 Then
Application.Quit
Else
Workbooks(ActiveWorkbook.Name).Close SaveChanges:=True
End If
End If

Wenn der Dateiname abweicht (also gar nichts geschlossen wird) funktioniert es wie gewünscht. Das gleiche gilt, wenn nur diese eine Instanz offen ist, sie wird "gekillt". Wenn allerdings eine weitere Instanz offen ist, bleibt das Fenster trotz des Close erhalten und muss manuell geschlossen werden, was ich vermeiden möchte.
Wo steckt der Fehler? Oder muss ich das komplett anders aufsetzen?
Vielen Dank
Hans-Jürgen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Public Sub ProgrammBeenden() If Not objADODB Is Nothing Then If objADODB.State = adStateOpen Then objADODB.Close End If End If Set rstDaten = Nothing Application.WindowState = xlNormal If ActiveWorkbook.Name = "Archiv.xlsm" Then If Workbooks.Count = 1 Then Application.Quit Else Workbooks(ActiveWorkbook.Name).Close SaveChanges:=True End If End If End Sub

Hallo Hans-Jürgen,
vielleicht kannst Du mit nachfolgendem Code als Anregung etwas anfangen...
Er ermittelt alle vorhandenen Instanzen und gibt auch die Instanz des gesuchten Workbooks zurück.

Code:
[Cc][+][-] 
Option Explicit

Private Declare PtrSafe Function GetClassNameA Lib "user32" ( _
        ByVal hWnd As LongPtr, ByVal lpClassName As String, _
        ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function EnumWindows Lib "user32" ( _
        ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
Private Declare PtrSafe Function EnumChildWindows Lib "user32" ( _
        ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, _
        ByVal lParam As LongPtr) As Long
Private Declare PtrSafe Sub IIDFromString Lib "ole32.dll" ( _
        ByVal lpsz As String, ByRef lpiid As GUID)
Private Declare PtrSafe Sub AccessibleObjectFromWindow Lib "oleacc.dll" ( _
        ByVal hWnd As LongPtr, ByVal dwId As Long, ByRef riid As GUID, _
        ByRef ppvObject As Any)

Private Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type

Private Const IID_EXCELWINDOW = "{00020893-0000-0000-C000-000000000046}"
Private Const OBJID_NATIVEOM = &HFFFFFFF0

Private hWndChild() As LongPtr, iChildCount As Long
Private hWwndMain() As LongPtr, iWindowCount As Long
Private sAllHandles As String

Private Function GetApplications() As Application()
 Dim i As Long, iCount As Long
 Dim udtGuid As GUID, oWin As Window
 Dim oTmpApplications() As Application

 Erase hWndChild: iChildCount = 0       'Variablen zurücksetzen
 Erase hWwndMain: iWindowCount = 0
 
 Call IIDFromString(StrConv(IID_EXCELWINDOW, vbUnicode), udtGuid)

 Call EnumWindows(AddressOf EnumWindowProc, ByVal 0&)

 For i = LBound(hWwndMain) To UBound(hWwndMain)
     Call EnumChildWindows(hWwndMain(i), _
          AddressOf EnumChildWindowProc, ByVal 0&)
 Next i

'Alle Kinder-Fenster durchgehen
 sAllHandles = ","
 For i = LBound(hWndChild) To UBound(hWndChild)

   Call AccessibleObjectFromWindow(hWndChild(i), _
        OBJID_NATIVEOM, udtGuid, oWin)

   If Not oWin Is Nothing Then
 
     If InStr(sAllHandles, "," & CStr(oWin.Application.hWnd) & ",") = 0 Then
       ReDim Preserve oTmpApplications(iCount)
       Set oTmpApplications(iCount) = oWin.Application
       iCount = iCount + 1
       sAllHandles = sAllHandles & CStr(oWin.Application.hWnd) & ","
     End If
     
   End If
 Next i

 GetApplications = oTmpApplications

End Function

Private Function EnumWindowProc(ByVal hWnd As LongPtr, ByVal lParam As Long) As Long
'Durchlaufe alle Fenster und merke Excelfenster
 Dim sClassName As String * 256
 
 If Left$(sClassName, GetClassNameA(hWnd, sClassName, Len(sClassName))) _
    = "XLMAIN" Then                'Ist es ein  Excelfenster?

    ReDim Preserve hWwndMain(iWindowCount)  'Array dimensionieren
    hWwndMain(iWindowCount) = hWnd          'Fenster-Handle merken
    iWindowCount = iWindowCount + 1         'Weiterzählen

 End If
 EnumWindowProc = 1
End Function

Private Function EnumChildWindowProc(ByVal hWnd As LongPtr, ByVal lParam As Long) As Long
'Durchlaufe alle Kinder-Fenster und merke Excelfenster
 Dim sClassName As String * 256
 
 If Left$(sClassName, GetClassNameA(hWnd, sClassName, Len(sClassName))) _
    = "EXCEL7" Then

    ReDim Preserve hWndChild(iChildCount)   'Array dimensionieren
    hWndChild(iChildCount) = hWnd           'Fenster-Handle merken
    iChildCount = iChildCount + 1           'Weiterzählen
    EnumChildWindowProc = 0

 Else
    EnumChildWindowProc = 1
 End If
End Function

Sub SucheOffeneExcelmappe()
 Dim oApplications() As Application, WkB As Workbook
 Dim i As Long
 Dim sSuch As String
 
 sSuch = "Archiv.xlsm"
 oApplications = GetApplications
 For i = LBound(oApplications) To UBound(oApplications)
   For Each WkB In oApplications(i).Workbooks
    If WkB.Name Like sSuch Then
'Mach was.....
       MsgBox "Workbook " & WkB.Name & " wurde gefunden!", vbInformation, "Excel-Instanzen"
'       WkB.Close SaveChanges:=True         'Workbook schließen
'       oApplications(i).Quit               'Diese Excel-Instanz beenden
       Exit Sub
    End If
   Next WkB
 Next i
 MsgBox "Mappe '" & sSuch & "' ist ncht geöffnet!", vbInformation
End Sub

____________________
viele Grüße aus Freigericht
Karl-Heinz

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Schließen des Basisfensters

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread