Hallo!
Wer kann mir weiter Helfen? Dieser Code wird nicht sauber ausgeführt. Es werden die angegebenen Module in Modulname: mMakroLoeschen nicht gelöscht. (Weiter unten ist der Makrotext.
Aufbau:
Vor dem beenden von Excel:
- Alle Codes aufheben (unProtectSharing…)
- Div. Abfragen
- CommandBar Löschen
- Module löschen —> Funktioniert nicht?
- Code aktivieren (ProtectSharing)
- Speichern ActiveWorkbook.Close True
Sub Workbook_BeforeClose(Cancel As Boolean)
If ufinfoshowYN = True Then Exit Sub
ufInfo.progbarStatus.Value = 3
mDateneinlesen.reg_werte_lesen
ufInfo.lblVersion.Caption = "NHKDaten erfassung Version " & TlnVer & „.01“
ufInfo.lblInfo.Caption = „Datei wird beendet!“
Application.OnTime Now + TimeValue(„00:00:01“), „mDateneinlesen.ufInfoStatusEnd“
If ufinfoshowYN = False Then
ufinfoshowYN = True
ufInfo.Show
End If
End Sub
'---------------------------------------------------
'Weiterführendes Beenden des Programmes-------- Modul: mDateneinlesen–
Public Sub ufInfoStatusEnd()
Dim text1 As String
mDateneinlesen.AttributOpen ‘Setzt das Dateiatribut auf Offen
mSaveandProtect.unProtecterSharing ‘Speichert die Excelmappe nicht geschüzt
ufInfo.progbarStatus.Value = 30 ‘Gibt den Wert der Progressbar in ufInfo (uf = userForm) an
mSaveandProtect.Code_Protect_TDaten ‘Schüzt die Tabelle TDaten
mDateneinlesen.reg_werte_lesen ‘Liest Werte aus der Registry ein
If TlnRef „8“ Then ‘TlnRef ist ein Registry-wert
text = "Neue Strasse erfasst, Teilnehmer Kurs " & TDaten.Range(„S2“).Value & „erfasst“
ufAchtung.Show
Else
text = „Teilnehmer Kurs " & TDaten.Range(„S2“).Value & " erfasst“
End If
‘Mailversandabfrage……….
text1 = MsgBox(„Wollen Sie diese Mappe via Mail versenden?“, vbYesNo, „E-Mail“)
If text1 7 Then
TDaten.Activate
On Error Resume Next
ActiveWorkbook.SendMail Recipients:=EMail, Subject:=text, returnreceipt:=False
End If
Application.DisplayAlerts = False
mCommandBar.RemoveMenu ‘Löscht die selbst erstellte CommandBar
ufInfo.Hide
mMakroLoeschen.ModulLoeschen ‘Löschen der vorhandenen Module
'— Das eigentliche Problem! Es wird nicht sauber ausgeführt! Warum?
ufInfo.progbarStatus.Value = 50
mSaveandProtect.ProtecterSharing ‘Schützen der Arbeitsmappe
ufInfo.progbarStatus.Value = 90
mDateneinlesen.AttributClose
ActiveWorkbook.Close SaveChanges:=True
End Sub
‘---------------------------------------------------------------------
‘**************************Das folgende Modul wird zwar ausgeführt,
‘**************************löscht aber nicht die Makros! Warum
‘Löschen der Module------------Modulname: mMakroLoeschen–
Sub ModulLoeschen()
On Error Resume Next
Dim codeModul1 As Object
Dim codeModul2 As Object
Dim codeModul3 As Object
Dim codeModul4 As Object
Dim codeModul5 As Object
Dim codeModul6 As Object
Dim codeModul7 As Object
Dim codeModul8 As Object
‘uf = UserForm
‘m = Modul
‘Löschen der nicht benötigten Module
Set codeModul1 = ActiveWorkbook.VBProject.VBComponents(„ufAchtung“)
ActiveWorkbook.VBProject.VBComponents.Remove codeModul1
Set codeModul2 = ActiveWorkbook.VBProject.VBComponents(„ufEingabe“)
ActiveWorkbook.VBProject.VBComponents.Remove codeModul2
Set codeModul3 = ActiveWorkbook.VBProject.VBComponents(„ufKurseingabe“)
ActiveWorkbook.VBProject.VBComponents.Remove codeModul3
Set codeModul4 = ActiveWorkbook.VBProject.VBComponents(„ufOptionen“)
ActiveWorkbook.VBProject.VBComponents.Remove codeModul4
Set codeModul5 = ActiveWorkbook.VBProject.VBComponents(„mKurseingabe“)
ActiveWorkbook.VBProject.VBComponents.Remove codeModul5
Set codeModul6 = ActiveWorkbook.VBProject.VBComponents(„mDaten“)
ActiveWorkbook.VBProject.VBComponents.Remove codeModul6
Set codeModul7 = ThisWorkbook.VBProject.VBComponents(„mCommandBar“)
ThisWorkbook.VBProject.VBComponents.Remove codeModul7
Set codeModul8 = ThisWorkbook.VBProject.VBComponents(„mufShower“)
ThisWorkbook.VBProject.VBComponents.Remove codeModul8
Set codeModul1 = Nothing
Set codeModul2 = Nothing
Set codeModul3 = Nothing
Set codeModul4 = Nothing
Set codeModul5 = Nothing
Set codeModul6 = Nothing
Set codeModul7 = Nothing
Set codeModul8 = Nothing
End Sub
‘--------------------------------------------------------------------
Besten Dank für jeden Hinweis
Grüsse Sebastian