VBE Makros löschen
26.01.2005 17:29:10
annette
es ist alles ein wenig schleierhaft.
ich habe eine Arbeitsmappe mit mehreren Tabellen und Makros.
Es soll eine Exportdatei erstellt werden und in dieser neuen Datei sollen die alten Verknüpfungen und Makros nicht bestehen.
Bei mir tut es das auch. Jetzt habe ich die Datei einer Kollegin gegeben und auch unter Verweise Microsoft VBA Extensibiliy 5.3. bei ihr aktiviert.
Aber Excel tuts nicht, weiß jemand was da passiert bzw. nicht passiert ?
Muss ich noch andere Bibliotheken aktivieren?
Das entsprechende Makro ist weiter unten.
Grüße
Annette
Sub Exportdaten()
On Error Resume Next
Dim Tabelle As Worksheet
Dim zelle As Range
Dim s_Datum As String
Dim t_Zeit As String
If ActiveWorkbook.Saved = False Then ActiveWorkbook.Save
s_Datum = Date
t_Zeit = Time
Application.ScreenUpdating = False
''Verknüpfungen löschen
For Each Tabelle In ActiveWorkbook.Worksheets
Tabelle.Activate
For Each zelle In ActiveSheet.UsedRange
If InStr(zelle.Formula, "[") > 0 Then zelle.Value = zelle.Value
Next zelle
Next Tabelle
Worksheets("Gesamt").Activate
Call Meldung
ActiveWorkbook.SaveAs ActiveSheet.Name & "_" & s_Datum & "_" & Format(t_Zeit, "hhmmss") & ".xls"
Application.DisplayAlerts = True
Application.CommandBars("Ansichten").Delete
'Application.CommandBars("Standard").Visible = True
Application.CommandBars("Formatting").Visible = True
Application.CommandBars("Chart Menu Bar").Visible = True
Application.CommandBars("Worksheet Menu Bar").Visible = True
'Ausblenden der Tabellen
For Each Tabelle In ActiveWorkbook.Sheets
If Tabelle.Name <> ActiveSheet.Name Then
Tabelle.Visible = xlSheetVeryHidden
End If
Next Tabelle
Dim CodeObj As Object
If Val(Application.Version) >= 8 Then
With ActiveWorkbook.VBProject
For Each CodeObj In .VBComponents
Select Case CodeObj.Type
Case 1, 2
.VBComponents.Remove CodeObj
Case Else
With CodeObj.CodeModule
If .CountOfLines > 0 Then
.DeleteLines 1, .CountOfLines
End If
End With
End Select
Next
End With
End If
For Each CodeObj In ActiveWorkbook.Names
Select Case CodeObj.MacroType
Case xlFunction, xlCommand
CodeObj.Delete
End Select
Next
Application.ScreenUpdating = True
ActiveWorkbook.Save
End Sub
