Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen

Alle Makros durch Makro löschen

Betrifft: Alle Makros durch Makro löschen von: Daniel
Geschrieben am: 08.11.2014 11:35:30

Hallo Forum,

ich glaube bei meinem letzten Thread ist etwas schief gegangen also probiere ich es hier noch einmal.

Wir benutzen Dateien die über lange Jahre entwickelt wurden und in denen eine Menge ungenutzter Makros liegen die ich gerne entfernen möchte. (Ich glaube das diese ev. Instabilitäten/Abstürze verursachen)

Nun habe ich ein Makro gefunden das alle Makros in einer Datei löscht (s.u.) aber das wir sehr viele Dateien haben würde ich dieses gerne nutzen um alle Makros von allen Dateien in einem zu wählenden Ordner löscht. Am besten mit einem Auswahlmenue für den Ordner. Diese würde ich in meiner Personal.xlsb unterbringen und bei Bedarf die Dateien in dem entsprechenden Ordner bereinigen.

ich habe jetzt noch etwas code gefunden von dem ich gehofft habe das er das erfüllen kann was ich mir vorstelle. In diesen habe ich den code (kursiv) zum löschen der Makros sowie eine box zum Pfad eingeben eingefügt.

Die erste Fehlermeldung die ich bekomme is die "Methode calculation für das Objekt_Application" ist fehlgeschlagen. wenn ich dieses einfach mal ausschalte mit ' passiert gar nix mehr... Folgerung er hat nen Fehler und führt "fin" aus. Also das abgeschaltet dann kommt typen unverträglich für stCalc = .Calculation.

Zu allem überfluss führt er das zweite sub gar nicht in den Makros auf... keine Ahnung warum...

Hier bin ich leider völlig überfordert.

Ich hoffe Ihr könnt mir hier Helfen!!

Option Explicit
' Suchmuster gegebenenfalls anpassen
Const strEX As String = "*.xls*"
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : Files_Read
' Author    : Case (Ralf Stolzenburg)
' Date      : 15.10.2012
' Purpose   : Alle Dateien eines Ordners - Optional mit Unterordner...
'--------------------------------------------------------------------------
Sub Files_Read()
    Dim stCalc As Integer
    Dim strDir As String
    Dim objFSO As Object
    Dim objDir As Object
    Dim dirInfo As Object
    On Error GoTo Fin
    With Application
        .ScreenUpdating = False
        .AskToUpdateLinks = False
        .EnableEvents = False
        stCalc = .Calculation
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    ' Datei im gleichen Ordner wie Auswertungsdateien
    ' strDir = ThisWorkbook.Path & "\"
    ' Fester Ordner vorgegeben
    strDir = InputBox("Text ?", "Title") 'Verzeichniss pfad eingabe
    strDir = IIf(Right(strDir, 1) <> "\", strDir & "\", strDir)
    Set objDir = objFSO.getfolder(strDir)
    'dirInfo objDir, strEX, True ' Mit Unterordner
    dirInfo objDir, strEX, False ' Ohne Unterordner
Fin:
    With Application
        ' Bei Bedarf
        '.Goto (ThisWorkbook.Worksheets(1).Range("A1")), True
        .ScreenUpdating = True
        .AskToUpdateLinks = True
        .EnableEvents = True
        .Calculation = stCalc
        .DisplayAlerts = True
    End With
    Set objDir = Nothing
    Set objFSO = Nothing
End Sub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : dirInfo
' Author    : Case (Ralf Stolzenburg)
' Date      : 15.10.2012
' Purpose   : Rekursive Funktion alle Dateien...
'--------------------------------------------------------------------------

Sub MakroDel(ByVal objCurrentDir As Object, ByVal strName As String, _
    Optional ByVal blnTMP As Boolean = False)
    Dim varTMP As Variant
    For Each varTMP In objCurrentDir.Files
        If varTMP.Name Like strName Then
            If varTMP.Name <> ThisWorkbook.Name Then
                If Left(varTMP.Name, 1) <> "~" Then
                    ' Hier jetzt der Code um mit der Datei etwas zu machen
                    ' z. B. Öffnen, etwas auslesen oder was auch immer...
                    ' Im folgenden werden nur ein paar Informationen
                    ' im Direktfenster (VBE - STRG+G) ausgegeben
                    ' Diese Zeilen mit Debug.Print können natürlich
                    ' gelöscht bzw. auskommentiert werden
                   'alle Module löschen
                    
                        Set VB = Application.VBE.ActiveVBProject
                        For Each Objekt In ThisWorkbook.VBProject.vbComponents
                             If Objekt.Type = 1 Then VB.vbComponents.Remove _
                                VB.vbComponents(Objekt.Name)
                        Next Objekt
                    
                End If
            End If
        End If
    Next varTMP
    If blnTMP = True Then
        For Each varTMP In objCurrentDir.SubFolders
            dirInfo varTMP, strName, blnTMP
        Next varTMP
    End If
End Sub

  

Betrifft: Warum so kompliziert? von: RPP63
Geschrieben am: 08.11.2014 12:11:57

Hallo!
Um alle Makros zu löschen, wäre es doch einfacher, die Dateien als .xlsx zu speichern?

Gruß, Ralf


  

Betrifft: AW: Warum so kompliziert? von: Daniel
Geschrieben am: 09.11.2014 18:52:50

Hallo Ralf,

das hatte ich mir auch gedacht aber die Makros sind dann immer noch in der Datei enthalten. Wenn ich diese dann als xlsb speichern will oder neue Makros einfügen möchte sind alle wieder aktiv...

Gruß Daniel


  

Betrifft: Na dann erst mal schließen u.neu öffnen! oWorte von: Luc:-?
Geschrieben am: 09.11.2014 19:05:28

:-?


  

Betrifft: AW: Na dann erst mal schließen u.neu öffnen! oWorte von: Daniel
Geschrieben am: 09.11.2014 21:29:06

Das Hat bei mir auch super geklappt aber bei meinem Kollegen nicht. Wir haben es mehrfach probiert mit dem file auf verschiedenen Rechnern.

Gruss


  

Betrifft: Dann ist evtl noch irgendwo die Originaldatei ... von: Luc:-?
Geschrieben am: 09.11.2014 22:35:38

…vorhanden und wird bevorzugt geöffnet, Daniel,
alles andere wäre ziemlich ungewöhnlich ab Xl12…
Gruß, Luc :-?


  

Betrifft: Siehe Screenshot von: RPP63
Geschrieben am: 10.11.2014 07:41:44

Hi!
Bei meinem XL2010 erscheint folgende Message bei SpeichernUnter .xlsx:



Beachte den letzten Satz.

Gruß, Ralf


  

Betrifft: AW: Siehe Screenshot von: Daniel
Geschrieben am: 10.11.2014 17:32:40

Ja genau so habe ich es gemacht. Bei meinen Dateien hat es auch funktioniert aber bei Ihm ging es nicht. Ich werde es noch einmal ausprobieren.

Aus Interesse... ist das was ich vorhatte mit dem code denn möglich??

Gruß


 

Beiträge aus den Excel-Beispielen zum Thema "Alle Makros durch Makro löschen"