Code erkennt nicht immer offene Workbooks
02.04.2008 07:45:00
Wolfgang
der untenstehende Code soll u.a. die am Bildschirm geöffneten Excel-Mappen erkennen. Zuhause auf meinem Standalone-Rechner klappt das auch wunderbar. In der Vernetzung hakt es und der Code erkennt beiweitem nicht immer die offenen Arbeitsmappen. Kann das evtl. an der Vernetzung liegen. Aufgefallen ist mir dabei auch, dass die Mappen in der Vernetzung auf Grund XLT geöffnet werden. Hat da evtl. jemand eine Idee? - Danke schon jetzt wieder für die Rückmeldungen.
Gruß- Wolfgang
Private Sub UserForm_Initialize()
Dim objMappe As Workbook
Dim objTabelle As Worksheet
Dim intI As Integer
On Error GoTo Abbrechen
Set objWbZiel = ThisWorkbook
'Auswahlliste für Combobox Quelldateien erstellen
With Me.cboQuelleMappe
For Each objMappe In Application.Workbooks
Select Case objMappe.Name
'Namen der nicht wählbaren Mappen
Case objWbZiel.Name
'do nothing
Case Else
'Nur die sichtbaren Mappen in die Auswahlliste aufnehmen
If Application.Windows(objMappe.Name).Visible = True Then
.AddItem objMappe.Name
End If
End Select
Next
If .ListCount = 0 Then
MsgBox "Es wurde noch keine Quelldatei geöffnet!"
Else
'1. Eintrag in Liste wählen
.ListIndex = 0
End If
End With
'Auswahlliste für Combobox Zieltabellen erstellen
With Me.cboZielTabelle
For Each objTabelle In objWbZiel.Worksheets
Select Case objTabelle.Name
'Namen der nicht wählbaren Tabellen
Case "Abfrage"
'do nothing
Case Else
'Nur die sichtbaren Tabellen in die Auswahlliste aufnehmen
If objTabelle.Visible = xlSheetVisible Then
.AddItem objTabelle.Name
End If
End Select
Next
End With
Set objMappe = Nothing: Set objTabelle = Nothing
Exit Sub
Abbrechen:
MsgBox Err.Number & vbLf & Err.Description
Unload Me
End Sub