AW: Namen der Tabellblätter aus geschlossen xls ausles
02.05.2009 21:59:21
Josef
Hallo Fenja,
den Pfad und Namen der Textdatei musst du im Code anpassen.
Zur zeit wird die Datei im Pfad der Exceldatei als "Tabellen.txt" abgelegt!
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub listSheetsInWorkbook()
Dim objWB As Workbook, objWS As Object
Dim strFile As String, blnClose As Boolean
Dim strMsg As String, strTxtFile As String
On Error GoTo ErrExit
GMS
strTxtFile = ThisWorkbook.Path & "\Tabellen.txt" 'Pfad und Name der Textdatei - Anpassen!
strFile = Application.GetOpenFilename("Excel Dateien (*.xls; *.xlsx; *.xlsm)," & _
"*.xls; *.xlsx; *.xlsm")
If strFile = "Falsch" Then Exit Sub
If IsOpen(strFile) Then
Set objWB = Workbooks(Mid(strFile, InStrRev(strFile, "\") + 1))
Else
Set objWB = Workbooks.Open(strFile)
blnClose = True
End If
For Each objWS In objWB.Sheets
strMsg = strMsg & objWS.Name & vbLf
Next
If blnClose Then objWB.Close False
If Len(strMsg) > 0 Then
strMsg = Left(strMsg, Len(strMsg) - 1)
Open strTxtFile For Output As #1
Print #1, strFile
Print #1, strMsg;
Close #1
MsgBox "Die Tabellennamen der Datei" & vbLf & vbLf & vbTab & strFile & vbLf & _
vbLf & "wurden in der Textdatei """ & strTxtFile & """ gespeichert!", vbInformation
End If
ErrExit:
With Err
If .Number <> 0 Then MsgBox "Fehler " & .Number & vbLf & vbLf & _
.Description & vbLf & vbLf & "In Prozedur (listSheetsInWorkbook) in Modul Modul1", _
vbExclamation, "Fehler in Modul1 / listSheetsInWorkbook"
End With
GMS True
End Sub
Private Function IsOpen(FileName As String) As Boolean
Dim objWB As Workbook
If InStr(1, FileName, "\") > 0 Then
For Each objWB In Application.Workbooks
If objWB.FullName = FileName Then
IsOpen = True
Exit For
End If
Next
Else
For Each objWB In Application.Workbooks
If objWB.Name = FileName Then
IsOpen = True
Exit For
End If
Next
End If
End Function
Public Sub GMS(Optional ByVal Modus As Boolean = False)
Static lngCalc As Long
With Application
.ScreenUpdating = Modus
.EnableEvents = Modus
.DisplayAlerts = Modus
.EnableCancelKey = IIf(Modus, 1, 0)
If Not Modus Then lngCalc = .Calculation
If Modus And lngCalc = 0 Then lngCalc = -4105
.Calculation = IIf(Modus, lngCalc, -4135)
.Cursor = IIf(Modus, -4143, 2)
End With
End Sub
Gruß Sepp