Sicherheitskopie Module löschen

Hallo zusammen,
Habe mich in der Recherche schlau gemacht und auch gefunden was ich wollte. Nur bei der Umsetzung stehe ich wieder vor einem Problemchen. Vielleicht kann mir jemand auf die Sprünge helfen.
Folgendes möchte ich umsetzen. Beim öffnen meiner Datei soll eine Sicherheitskopie angelegt werden.
Dies funktioniert super - setze ich so um.


Sub sicherheit()
ActiveWorkbook.SaveCopyAs "D:\Frank\" & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)  _
&  "_" & Format(Now, "MM.DD") & ".xls"
End Sub

Da es mir dabei vielmehr um die Werte geht möchte ich auf einen großteil der Makros verzichten.
Deswegen sollen die Module1 und 11 sowie Diese Arbeitsmappe von den Makros befreit werden.
Im aktiven Workbook sieht das so aus:
Dim WB As Workbook
Set WB = ActiveWorkbook
With WB.VBProject.VBComponents("DieseArbeitsmappe").CodeModule
.DeleteLines 1, .CountOfLines
End With
'Modul löschen
With Application.VBE.ActiveVBProject
.VBComponents.Remove .VBComponents("Modul1")
.VBComponents.Remove .VBComponents("Modul11")
End With
Wie ändere ich das so um, dass das nur auf meine Kopie zutrifft?
Gruß Frank

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit


Private Sub CommandButton1_Click()
Dim intIndex As Integer
Dim blnFound As Boolean
Dim strRef   As String
blnFound = False
strRef = "Microsoft Visual Basic for Applications Extensibility"
With ThisWorkbook.VBProject.References
For intIndex = 1 To .Count
Debug.Print .Item(intIndex).Description, .Item(intIndex).GUID
If Left(.Item(intIndex).Description, Len(strRef)) = strRef Then
If .Item(intIndex).IsBroken Then
.Remove (.Item(intIndex))
Else
blnFound = True
End If
Exit For
End If
Next intIndex
If Not blnFound Then
Call Application.VBE.ActiveVBProject.References.AddFromGuid("{0002E157-0000-0000-C000- _
000000000046}", 5, 3)
End If
End With
Dim sFilename As String
Application.ScreenUpdating = False
sFilename = "D:\Frank\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 0) & _
Format(Now(), "_DD.MM") & ".xls"
ThisWorkbook.SaveCopyAs Filename:=sFilename
Call CodeEntfernen(sFilename)
Call CommandButtonEntfernen(sFilename)
End Sub


Private Function CodeEntfernen(sFilename As String)
Dim Wb As Workbook, VBComp As VBComponent
Dim x As Long
Set Wb = Workbooks.Open(Filename:=sFilename)
For x = Wb.VBProject.VBComponents.Count To 1 Step -1
Set VBComp = Wb.VBProject.VBComponents(x)
If VBComp.Type = vbext_ct_StdModule Or _
VBComp.Type = vbext_ct_ClassModule Or _
VBComp.Type = vbext_ct_MSForm Then
Wb.VBProject.VBComponents.Remove VBComp
ElseIf VBComp.Type = vbext_ct_Document Then
VBComp.CodeModule.DeleteLines 1, VBComp.CodeModule.CountOfLines
End If
Next
Wb.Close Savechanges:=True
AUFRAEUMEN:
Set Wb = Nothing: Set VBComp = Nothing
End Function


Private Function CommandButtonEntfernen(sFilename As String)
Dim Wb As Workbook, ws As Worksheet
Dim x As Long
Set Wb = Workbooks.Open(Filename:=sFilename)
For Each ws In Wb.Worksheets
For x = ws.OLEObjects.Count To 1 Step -1
If ws.OLEObjects(x).progID = "Forms.CommandButton.1" Then
ws.OLEObjects(x).Delete
End If
Next
Next
Wb.Close Savechanges:=True
AUFRAEUMEN:
Set Wb = Nothing: Set ws = Nothing
End Function

Private Sub CommandButton1_Click() Dim intIndex As Integer Dim blnFound As Boolean Dim strRef As String blnFound = False strRef = "Microsoft Visual Basic for Applications Extensibility" With ThisWorkbook.VBProject.References For intIndex = 1 To .Count Debug.Print .Item(intIndex).Description, .Item(intIndex).GUID If Left(.Item(intIndex).Description, Len(strRef)) = strRef Then If .Item(intIndex).IsBroken Then .Remove (.Item(intIndex)) Else blnFound = True End If Exit For End If Next intIndex If Not blnFound Then Call Application.VBE.ActiveVBProject.References.AddFromGuid("{0002E157-0000-0000-C000- _ 000000000046}", 5, 3) End If End With Dim sFilename As String Application.ScreenUpdating = False sFilename = "D:\Frank\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 0) & _ Format(Now(), "_DD.MM") & ".xls" ThisWorkbook.SaveCopyAs Filename:=sFilename Call CodeEntfernen(sFilename) Call CommandButtonEntfernen(sFilename) End Sub

Private Function CodeEntfernen(sFilename As String) Dim Wb As Workbook, VBComp As VBComponent Dim x As Long Set Wb = Workbooks.Open(Filename:=sFilename) For x = Wb.VBProject.VBComponents.Count To 1 Step -1 Set VBComp = Wb.VBProject.VBComponents(x) If VBComp.Type = vbext_ct_StdModule Or _ VBComp.Type = vbext_ct_ClassModule Or _ VBComp.Type = vbext_ct_MSForm Then Wb.VBProject.VBComponents.Remove VBComp ElseIf VBComp.Type = vbext_ct_Document Then VBComp.CodeModule.DeleteLines 1, VBComp.CodeModule.CountOfLines End If Next Wb.Close Savechanges:=True AUFRAEUMEN: Set Wb = Nothing: Set VBComp = Nothing End Function

Private Function CommandButtonEntfernen(sFilename As String) Dim Wb As Workbook, ws As Worksheet Dim x As Long Set Wb = Workbooks.Open(Filename:=sFilename) For Each ws In Wb.Worksheets For x = ws.OLEObjects.Count To 1 Step -1 If ws.OLEObjects(x).progID = "Forms.CommandButton.1" Then ws.OLEObjects(x).Delete End If Next Next Wb.Close Savechanges:=True AUFRAEUMEN: Set Wb = Nothing: Set ws = Nothing End Function

Private Sub Workbook_Open() Tabelle3.Visible = xlSheetVisible If UCase(ThisWorkbook.Path) UCase("O:\Excel") Then MsgBox "Datei vom falschen Ordner gestartet:" & ThisWorkbook.Path, vbCritical ThisWorkbook.Close UserForm_Initialize.Show ' UF starten End Sub

Private Sub Workbook_Open() Tabelle3.Visible = xlSheetVisible If UCase(ThisWorkbook.Path) UCase("D:\Frank") Then 'Sicherheitskopie If UCase(ThisWorkbook.Path) UCase("K:\Excel") Then ' Originalort MsgBox "Datei vom falschen Ordner gestartet:" & ThisWorkbook.Path, vbCritical ThisWorkbook.Close End If End If If ActiveWorkbook.Name ("Frank.xls") Then lese_schreibe End if UserForm_Initialize.Show ' UF starten sicherheit End Sub

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Sicherheitskopie Module löschen

14 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)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread