VBA-Kenner: Neue Erkenntnisse
06.04.2007 17:20:00
Fritz_W
Hallo VBA-Experten,
die Umgereimtheiten im Umgang mit dem nachstehenden (abgeänderten!!) Code haben mich veranlasst, die Tests auszuweiten. Schließlich habe ich festgestellt, dass solange der abgeänderte Code verwendet wird, auftretende Probleme wohl darauf zurückzuführen sind, dass der Code bei der der Anweisung: "If Not (SheetExists(lngL)) Then" evtl. auch Tabellen "berücksichtigt" deren Dateinamen nicht aus einer Zahl besteht, die zwischen dem Eintrag in "Daten!C2" und "Daten!C3" liegt,
während bei dem ursprünglichen Code nur die Tabellen mit dem "Zusatz" "A" berücksichtigt werden. Zumindest lassen meine Tests eine derartige Vermutung zu. Aber die Experten in diesem Forum können sicher besser beurteilen, ob das die Ursache für die Ungereimtheiten sein kann.
Vielleicht kann einer von euch auch den Code entsprechend meinen Vorstellungen anpassen!
Vielen Dank im Voraus.
Mfg
Fritz
ursprünglicher Code:
Sub NeueTabellen()
Dim lngL As Long
For lngL = Worksheets("Daten").[c2] To Worksheets("Daten").[c3]
If Not (SheetExists(lngL & "A")) Then
Worksheets("Vorlage").Copy After:=Worksheets("Daten")
ActiveSheet.Name = lngL & "A"
ActiveSheet.[c2] = lngL
End If
Next lngL
End Sub
Funktionscode:
'Prüfen, ob ein Blatt in einer Arbeitsmappe existiert - von NoNet
Function SheetExists(blattname) As Boolean
Dim dummy
On Error Resume Next
dummy = Sheets(blattname).Type
SheetExists = (Err = 0)
End Function
abgeänderter Code:
Sub Tabellen_anlegen()
'Fügt entsprechend der Angaben in den Zellen C2 und C3 der Tabelle "Daten" Kopien der Tabelle
'"Vorlage" in die Arbeitsmappe ein und fügt die jeweilige Zahl in die Zelle C2 der
' Kopie ein
Dim lngL As Long
For lngL = Worksheets("Daten").[c2] To Worksheets("Daten").[c3]
If Not (SheetExists(lngL)) Then
Worksheets("Vorlage").Copy After:=Worksheets("Daten")
ActiveSheet.Name = lngL
ActiveSheet.[c2] = lngL
End If
Next lngL
End Sub
'Prüfen, ob ein Blatt in einer Arbeitsmappe existiert - von NoNet
Function SheetExists(blattname) As Boolean
Dim dummy
On Error Resume Next
dummy = Sheets(blattname).Type
SheetExists = (Err = 0)
End Function
