Makros löschen

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Const FOLDER_PATH As String = "______ Hier steht mein Pfad drin_____" Dim strFilename As String With ThisWorkbook strFilename = Left$(.Name, InStrRev(.Name, ".") - 1) strFilename = strFilename & Format(Now, "_yyyymmdd_hh-mm_") & _ Mid$(.Name, InStrRev(.Name, ".")) Call .SaveCopyAs(FOLDER_PATH & strFilename) End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Const FOLDER_PATH As String = "______ Hier steht mein Pfad drin_____" Dim strFilename As String With ThisWorkbook strFilename = Left$(.Name, InStrRev(.Name, ".") - 1) strFilename = strFilename & Format(Now, "_yyyymmdd_hh-mm_") & _ Mid$(.Name, InStrRev(.Name, ".")) 'Code bzw. Module löschen Call deleteCode(ThisWorkbook, "UserForm1") 'entfernt 'UserForm1' Call deleteCode(ThisWorkbook, "Modul4") 'entfernt das gesamte 'Modul4' Call deleteCode(ThisWorkbook, "Modul3", "DeinMakro") 'entfernt 'DeinMakro' aus 'Modul3' Call deleteCode(ThisWorkbook, "Tabelle1") 'entfernt gesamten Code aus dem Modul der 'Tabelle1' (CodeName) Call .SaveCopyAs(FOLDER_PATH & strFilename) End With End Sub Private Sub deleteCode(ByVal WBook As Workbook, ByVal ModulName As String, Optional ProcName As String) Dim objVBComp As Object Dim lngStart As Long, lngCount As Long With WBook.VBProject For Each objVBComp In .vbComponents If objVBComp.Name = ModulName Then If objVBComp.Type = 100 Or ProcName <> "" Then With .vbComponents(objVBComp.Name).CodeModule If ProcName = "" Then .DeleteLines 1, .CountOfLines Else lngStart = .ProcStartLine(ProcName, vbext_pk_Proc) lngCount = .ProcCountLines(ProcName, vbext_pk_Proc) .DeleteLines lngStart, lngCount End If End With Else .vbComponents.Remove objVBComp End If End If Next End With End Sub

Hallo Max,
wie geht's dir immer?
Du hast natürlich recht, hab wohl zu schnell geschossen.
So sollte es aber klappen.

' **********************************************************************
' Modul: DieseArbeitsmappe  Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim strFilename As String
Dim objWB As Workbook

Const FOLDER_PATH As String = "E:\Forum\Test2\"

Application.EnableEvents = False

With ThisWorkbook
  strFilename = Left$(.Name, InStrRev(.Name, ".") - 1)
  strFilename = strFilename & Format(Now, "_yyyymmdd_hh-mm_") & _
    Mid$(.Name, InStrRev(.Name, "."))
  
  Call .SaveCopyAs(FOLDER_PATH & strFilename)
  
  Set objWB = Workbooks.Open(FOLDER_PATH & strFilename)
  
  'Code bzw. Module löschen
  Call deleteCode(objWB, "DieseArbeitsmappe") 'entfernt den Code aus 'DieseArbeitsmappe1'
  Call deleteCode(objWB, "UserForm1") 'entfernt 'UserForm1'
  Call deleteCode(objWB, "Modul2") 'entfernt das gesamte 'Modul2'
  Call deleteCode(objWB, "Modul1", "DeinMakro") 'entfernt 'DeinMakro' aus 'Modul1'
  Call deleteCode(objWB, "Tabelle1") 'entfernt gesamten Code aus dem Modul der 'Tabelle1' (CodeName)
  objWB.Close True
  
End With

Application.EnableEvents = True
End Sub

Private Sub deleteCode(ByVal WBook As Workbook, ByVal ModulName As String, Optional ProcName As String)
Dim objVBComp As Object
Dim lngStart As Long, lngCount As Long

With WBook.VBProject
  For Each objVBComp In .vbComponents
    If objVBComp.Name = ModulName Then
      If objVBComp.Type = 100 Or ProcName <> "" Then
        With .vbComponents(objVBComp.Name).CodeModule
          If ProcName = "" Then
            .DeleteLines 1, .CountOfLines
          Else
            lngStart = .ProcStartLine(ProcName, 0)
            lngCount = .ProcCountLines(ProcName, 0)
            .DeleteLines lngStart, lngCount
          End If
        End With
      Else
        .vbComponents.Remove objVBComp
      End If
    End If
  Next
End With
End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makros löschen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread