Weiterhin habe ich zwei Spalten mit Zahlen im Währungsformat.Die Zweite Spalte wird korrekt übertragen,die erste Spalte erscheint als $20,00 statt 20,00.
Sub Schaltfläche4_BeiKlick() 'Rechnung speichern
Dim wb As Workbook
Dim dName As String
Dim sPfad As String
On Error GoTo err
dName = Worksheets("Re").Range("A2") & ".xls" 'name des Dateinamens
sPfad = "D:\versuchgewerbe\kunden\" & dName 'Name des Speicherpfades
Set wb = Workbooks("Rechnung.xls")
If Dir(sPfad) = "" Then 'Wenn Datei noch nicht besteht
Sheets("Re").Copy
For Each Shp In ActiveSheet.Shapes 'Schaltfläche löschen
Shp.Delete
Next Shp
ActiveSheet.OLEObjects.Delete 'Formeln löschen
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value ActiveWorkbook.SaveAs Filename:=sPfad 'speichern
ActiveWorkbook.Close
Else
Set wb = Workbooks.Open(sPfad) 'vorhandene Datei öffnen
Workbooks("Rechnung.xls").Sheets("Re").Copy After:=wb.Worksheets(wb.Worksheets.Count) 'in Datei kopieren u. hinten einfügen
For Each Shp In ActiveSheet.Shapes
Shp.Delete
Next Shp
ActiveSheet.OLEObjects.Delete
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
Exit Sub
err:
MsgBox err.Description, vbCritical
End Sub