Microsoft Excel

Herbers Excel/VBA-Archiv

Blatt automatisch löschen .... | Herbers Excel-Forum


Betrifft: Blatt automatisch löschen .... von: WalterK
Geschrieben am: 19.11.2009 20:19:57

Hallo,

Meine Mappe "Zusammenfassung" hat mehrere Blätter.

Aus anderen Mappen werden über "verschieben/kopieren" Blätter in diese Mappe kopiert.

Wird ein Blatt mit dem Namen "Aufstellung" hinein kopiert, soll geprüft werden, ob in der Mappe "Zusammenfassung" ein solches Blatt schon vorhanden ist. Wenn ja, soll zuerst das "alte" Blatt "Aufstellung" gelöscht werden und dann das neue Blatt "Aufstellung" hinein kopiert werden.

Kann mir jemand behilflich sein.

Servus, Walter

  

Betrifft: Kopiertes Blatt aus Zielmappe löschen von: NoNet
Geschrieben am: 19.11.2009 22:53:27

Hallo Walter,

folgende Lösung sollte bei EINEM kopierten Blatt funktionieren :
Kopiere diesen VBA-Code in die Mappe "Zusammenfassung" in das Klassenmodul "DieseArbeitsmappe" im VBA-Editor :

Dim intBlattAnzahl

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
    Dim shDummy
    
    If ThisWorkbook.Sheets.Count > intBlattAnzahl Then
        On Error Resume Next
        Err.Clear
        
        Set shDummy = Sheets(Left(ActiveSheet.Name, Len(ActiveSheet.Name) - 4))
        
        If Err = 0 Then
            Application.DisplayAlerts = False
            Sheets(Left(ActiveSheet.Name, Len(ActiveSheet.Name) - 4)).Delete
            ActiveSheet.Name = Left(ActiveSheet.Name, Len(ActiveSheet.Name) - 4)
            Application.DisplayAlerts = True
        End If
        
        On Error GoTo 0
    End If
End Sub

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
    intBlattAnzahl = ThisWorkbook.Sheets.Count
End Sub
Gruß, NoNet

PS : Das funktioniert allerdings nur, wenn EIN Blatt kopiert wurde (dieses ist dann das aktuelle Blatt), falls mehrere Blätter kopiert wurden, versagt das Makro, da nicht feststellbar ist, WELCHE Blätter hinein kopiert wurden (Excel bietet dazu leider kein Ereignis und kein passendes Objekt !).


  

Betrifft: Klappt wunderbar ... von: WalterK
Geschrieben am: 19.11.2009 23:15:47

Hallo NoNet,

... genau so sollte es sein (die Blätter werden auch nur einzeln hinein kopiert).

Besten Dank und Servus, Walter


  

Betrifft: Jetzt funktioniert es doch noch nicht ganz... von: WalterK
Geschrieben am: 19.11.2009 23:38:16

Hallo NoNet,

ich habe es jetzt an meiner Originaldatei ausprobiert.

Der Code funktioniert, solange der Blattname höchstens 27 Stellen lang ist. Bei 28 Stellen funktioniert der Code nicht mehr (darauf muss man erst einmal kommen!?!).

Mein Blattname hat 29 Stellen und der ist so vorgegeben.

Lässt sich da etwas machen?

Danke und Servus, Walter


  

Betrifft: Ich hatte es fast befürchtet... von: NoNet
Geschrieben am: 20.11.2009 00:10:35

Hallo Walter,

als ob ich geahnt hätte : Beim Erstellen des Codes war mir diese Begrenzung schon klar :
Da Tabellenblätter maximal 31 Zeichen lang sein dürfen und der VBA-Code den Zusatz " (2)" der kopierten Blätter "abschneidet", lag es nahe, dass Blätter mit mehr als 27 Zeichen im Namen Probleme bereiten würden. Ich hatte nur gehofft, dass Deine Blattnamen deutlich kürzer sind....

Das Problem mit mehr als27 Zeichen lässt sich nicht zu 100% lösen, da man ja nicht erahnen kann, wie das Blatt zuvor hieß ;-). Wenn allerdings zumindest die ersten 27 Stellen eindeutig sind, dann sollte folgender angepasster Code "passen" :

Dim intBlattAnzahl

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
    Dim shDummy, shTemp, strShName As String
    
    If ThisWorkbook.Sheets.Count > intBlattAnzahl Then
        On Error Resume Next
        Err.Clear
        
        strShName = Left(ActiveSheet.Name, Len(ActiveSheet.Name) - 4)
        If Len(strShName) < 27 Then
            Set shDummy = Sheets(strShName)
        Else
            Err = 1
            For Each shTemp In Sheets
                If UCase(shTemp.Name) Like UCase(strShName) & "*" And _
                    shTemp.Name <> ActiveSheet.Name Then
                    strShName = shTemp.Name
                    Set shDummy = shTemp
                    Err = 0
                    Exit For
                End If
            Next
        End If
        
        If Err = 0 Then
            Application.DisplayAlerts = False
            shDummy.Delete
            ActiveSheet.Name = strShName
            Application.DisplayAlerts = True
        End If
        
        On Error GoTo 0
    End If
End Sub

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
    intBlattAnzahl = ThisWorkbook.Sheets.Count
End Sub
Gruß, NoNet


  

Betrifft: Besten Dank, jetzt funktionierts. Servus, Walter von: WalterK
Geschrieben am: 20.11.2009 07:39:16




  

Betrifft: AW: Jetzt funktioniert es doch noch nicht ganz... von: fcs
Geschrieben am: 20.11.2009 01:27:42

Hallo Walter,

da ist bei dem Makro in der Form dann nichts zu machen, die Zeichenzahl für Tabellenblattnamen ist auf 31 begrenzt.
Beim Kopieren gleicher Blattnamen fügt Excel ja automatisch die Zählnummer in Klammern ein. Wird dabei die max. Namenslänge erreicht, dann werden Zeichen des Namens überschrieben. Das wird dir hier zum Verhängnis.

Um das zu umgehen müßtest du anders kopieren. Nämlich das zu kopierende Blatt "holen" statt es in die Datei "reinzuschmeissen". Dann kann man vor dem Einfügen des geholten Blattes prüfen ob ein Blatt gleichen Namens schon vorhanden ist. Das ist allerdings etwas aufwendiger in der Programmierung.

Gruß
Franz


Beiträge aus den Excel-Beispielen zum Thema "Blatt automatisch löschen ...."