Tabelle ohne VBA Code speichern
15.05.2012 18:40:13
Giuseppe Bonfirraro
Hallo lieber Helfer in der Not,
wenn ich nicht mehr weiter komme, ist das Herbers Excel-Forum meine letzte Chance!
Mit dem unterstehendem Code werden 2 Tabellen von VBA Code befreit und als neu Datei gespeichert.
Der Code macht seine Arbeit wie gewünscht bis auf eines optisches störendes Faktor: während und nach der Ausführung des Codes erscheint das Fenster der VBA Umgebung.
Wie kann man es vermeiden?
Ich weiss, dass kann man auch mit workbooks.add eine Tabelle ohne VBA Code speichern, aber ich weiss es nicht wie!
Hier der Code:
Sub Rechnung_Speichern1()
Speed 'Application.ScreenUpdating = False
Dim sPath As String, S As String
S = Worksheets("Rechnung").Range("i19").Value '& ".xls."
sPath = "C:\OFFICE CONTROL ©\Rechnungen\"
If MsgBox("Rechnung '" & Range("i19") & "' speichern ? ", vbYesNo, "OFFICE CONTROL ©") = 7 Then _
Exit Sub
With Application
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
RE_copy 'kopiert 2 Tabelle ( Rechnung und Stundenerfassung) und fügt mit d. unterstehenden _
Namen hinzu
Dateischutz_auf
Sheets(Array("st_save", "re_save")).Copy
ActiveWorkbook.PrecisionAsDisplayed = False
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
'alle_Makros_loeschen
VBA_Kennwort
RemoveAllMacros ActiveWorkbook
ActiveSheet.Name = S
ActiveWorkbook.SaveAs Filename:=sPath & S & ".xls" ', FileFormat:=xlNormal, Password:="", _
WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=True
ActiveWorkbook.Close savechanges:=True
'löscht die temp.Tabelle
Sheets("st_save").Select
ActiveWindow.SelectedSheets.Delete
Sheets("re_save").Select
ActiveWindow.SelectedSheets.Delete
With Application
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
ActiveWorkbook.PrecisionAsDisplayed = True
MsgBox ("Die Rechnung " & S & " wurde gespeichert")
Akt 'Application.ScreenUpdating = True
goto_Rechnung
Dateischutz_ein
End Sub
und der Code für VBA Code entfernen:
Sub RemoveAllMacros(objDocument As Object)
Dim i As Long, l As Long
If objDocument Is Nothing Then Exit Sub
i = 0
On Error Resume Next
i = objDocument.VBProject.VBComponents.Count
On Error GoTo 0
If i < 1 Then
MsgBox "The VBProject in " & objDocument.Name & " is protected or has no components!", _
vbInformation, "Remove All Macros"
Exit Sub
End If
With objDocument.VBProject
For i = .VBComponents.Count To 1 Step -1
On Error Resume Next
.VBComponents.Remove .VBComponents(i)
On Error GoTo 0
Next i
End With
With objDocument.VBProject
For i = .VBComponents.Count To 1 Step -1
l = 1
On Error Resume Next
l = .VBComponents(i).CodeModule.CountOfLines
.VBComponents(i).CodeModule.DeleteLines 1, l
On Error GoTo 0
Next i
End With
End Sub
Kann mir bitte jemand sagen, wo die Fehler sind?Vielen Dank im Voraus
G. Bonfirraro