Multipages automatisch beschriften
18.08.2003 13:05:16
Daniel Z
ich brüte seit einer halben Ewigkeit an einem Problemchen und befürchte, dass ich vor lauter Bäumen den Wald nicht mehr sehe und die Lösung eigentlich ganz einfach ist. Pleeeze help!
Folgendes Problem:
Ich habe einen UserForm programmiert auf dem sich wiederum ein Multipage-Objekt befindet. Die Anzahl der zu erstellenden Pages hängt von der Anzahl der xls-Dateien in einem bestimmten Ordner ab. Nun möchte ich, dass die Caption jeder Page den Namen einer bestimmten Zelle im jeweiligen xls-File übernimmt. Genau dies funktioniert bei mir, solange es sich nicht um die ersten beiden xls-Files handelt. Bei den Files 1 und 2 überschreibt er mir die Caption nicht.
Hier mein Code:
Private Sub Pages_benennen()
Const Laufwerk = "C:\"
Const Pfad = "C:\Eigene Dateien"
Dim Mappe As String 'liest den Namen für die Caption aus
Dim bereits_offen As Integer 'überprüft wieviele xls-Files zu Beginn
'bereits geöffnet sind
bereits_offen = Workbooks.Count
ChDrive Laufwerk
ChDir Pfad
On Error Resume Next
Set fs = Application.FileSearch 'zB die Files AAA.xls, BBB.xls, CCC.xls
With fs
.LookIn = Pfad
.Filename = "*.xls"
If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
MsgBox "Es existieren " & .FoundFiles.Count & " relevante Dateien!"
For x = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(x)
Mappe = Workbooks(bereits_offen + x).Sheets("Calc").Range("A1")
'hier wird der Name für die Caption ausgelesen, der sich in Zelle
'A1 befindet
Select Case x
Case 1, 2
UserForm1.MultiPage1.Page(x - 1).Name (Mappe)
'hier schafft er es nicht, die Caption von Page1 und 2
'zu überschreiben!
Case Is > 2
UserForm1.MultiPage1.Pages.Add (Mappe) 'funktioniert
'problemlos
End Select
Next x
Else
MsgBox "Es konnten keine relevanten Dateien gefunden werden!"
End If
End With
End Sub
Wäre super, wenn mir jemand von euch helfen könnte. DANKE!!!
LG Daniel
Anzeige