Sheet archivieren - VBA Fehlermeldung

Hallo Excelgemeinde/-Fans,
der gefundene Code hat mir schon mal geholfen , allerdings nun mit Fehler :
1004- Anwendungs oder -objektdefenierter Fehler.
Ich habe vorher mit Excel2003 gearbeitet nun mit excel2010 (13)
Aufgabe soll eigentlich nur sein das er Tabellenblatt "Rechnung" im Verzeichnis C:\Archiv\rechnung
speichert. Der Speichername erstellt sich aus meheren Zellen, wobei H7 das Rechnungsdatum ist.
Frage1:Muss der Code ins Arbeitsblatt oder wie ich es gemacht habe in ein Modul?
Gruß Matthias G.
Option Explicit
Sub exportPrintarea()
Dim rng As Range
Dim objWB As Workbook
Dim strName As String, strPath As String
On Error GoTo ErrExit
GMS
strPath = "C:\Archiv\Rechnung" 'Speicherpfad - Anpassen!
If Right(strPath, 1) "\" Then strPath = strPath & "\"
With Sheets("Rechnung") 'zu exportierende Tabelle - Anpassen!
Set rng = .Range("$A$1:$H$35")
strName = .Range("A3&B3&H7").Text & ".xls" 'Zelle mit dem zu vergebenden Namen - Anpassen!
End With
Set objWB = Workbooks.Add
rng.Copy
With objWB.Sheets(1).Range("A1")
.PasteSpecial -4163
.PasteSpecial -4122
.PasteSpecial 8
End With
Application.CutCopyMode = False
objWB.SaveAs strPath & strName
objWB.Close
ErrExit:
If Err.Number 0 Then MsgBox Err.Number & vbLf & Err.Description, vbExclamation, "Fehler"
GMS True
Set rng = Nothing
Set objWB = Nothing
End Sub

Public Sub GMS(Optional ByVal Modus As Boolean = False)
Static lngCalc As Long
With Application
.ScreenUpdating = Modus
.EnableEvents = Modus
.DisplayAlerts = Modus
.EnableCancelKey = IIf(Modus, 1, 0)
If Not Modus Then lngCalc = .Calculation
If Modus And lngCalc = 0 Then lngCalc = -4105
.Calculation = IIf(Modus, lngCalc, -4135)
.Cursor = IIf(Modus, -4143, 2)
End With
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Option Explicit Sub exportPrintarea2() Dim rng As Range, lngZ As Long Dim objWB As Workbook Dim strName As String, strPath As String strPath = "C:\Archiv\Rechnung" 'Speicherpfad - Anpassen! If Right(strPath, 1) "\" Then strPath = strPath & "\" With Sheets("Rechnung") 'zu exportierende Tabelle - Anpassen! Set rng = .Range("$A$1:$H$35") strName = .Range("A3&B3&H7").Text & ".xls" 'zu vergebender Dateiname - Anpassen! End With Set objWB = Workbooks.Add rng.Copy With objWB.Sheets(1).Range("A1") .PasteSpecial xlPasteValues ' -4163 .PasteSpecial xlPasteFormats ' -4122 .PasteSpecial xlPasteColumnWidths ' 8 End With ' Zeilenhöhe kopieren geht so nicht Application.CutCopyMode = False ' ------------------------------------------------------------ neu ActiveWindow.DisplayZeros = False ' keine Nullenanzeige For lngZ = 1 To 35 objWB.Sheets(1).Rows(lngZ).RowHeight = rng.Rows(lngZ).RowHeight Next lngZ ' ------------------------------------------------------------ neu Ende objWB.SaveAs strPath & strName objWB.Close End Sub

Sub exportPrintarea() Dim rng As Range Dim objWB As Workbook Dim strName As String, strPath As String On Error GoTo ErrExit GMS strPath = "C:\Archiv\Rechnung" 'Speicherpfad - Anpassen! If Right(strPath, 1) "\" Then strPath = strPath & "\" With Sheets("Rechnung") 'zu exportierende Tabelle - Anpassen! Set rng = .Range("$A$1:$F$35") strName = .Range("F6").Text & ".xls" 'Zelle mit dem zu vergebenden Namen - Anpassen! End With Set objWB = Workbooks.Add(xlWBATWorksheet) rng.Copy With objWB.Sheets(1).Range("A1") .PasteSpecial -4163 .PasteSpecial -4122 .PasteSpecial 6 ' Einfach mal gemacht, seitdem ging die Zeilenhoehe .PasteSpecial 8 End With Application.CutCopyMode = False ' Copymodus verlassen ActiveWindow.DisplayZeros = False ' keine Nullenanzeige - von Erichs vorschlag ü _ bernommen -Danke Range("A1").Select objWB.SaveAs strPath & strName ' Speichern unter objWB.Close ' Objekt schließen Call KD_Datenbank ' Makroaufruf ErrExit: ' Fehlermeldungen If Err.Number 0 Then MsgBox Err.Number & vbLf & Err.Description, vbExclamation, "Fehler" GMS True Set rng = Nothing Set objWB = Nothing End Sub

Hi Matthias,
zu ".PasteSpecial 6 ' Einfach mal gemacht, seitdem ging die Zeilenhoehe":
Da mag es einen zeritlichen Zusammenhang gegeben haben, einen sachlichen gibt es aber wohl nicht.
Der XlPasteType 6 steht für xlPasteValidation - das hat mit der Zeilenhöhe nichts zu tun,
damit werden Gültigkeitsprüfungen übernommen. Oder irre ich micht da? Ich werd das jetzt nicht testen...
Warum eigentlich schreibst du nur die Werte, nicht die Namen der XlPasteType-Konstanten?
Weißt du in ein paar Monaten noch auf Anhieb, wofür die -4163 steht? xlPasteValues ist sprechender.
Und vielleicht auch dauerhafter.
zu: "bei deinem Vorschlag kam die Meldund das die Variable lngZ nicht deklariert ist"
Bei meinem Vorschlag steht gleich in der 1. Codezeile:
Dim rng As Range, lngZ As Long
Ich halte lngZ damit für ausreichend deklariert und wäre über diese Meldung sehr erstaunt. ;-)
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort und: Einen schönen Sonntag!

Beliebteste Forumthreads (12 Monate)

Sheet archivieren - VBA Fehlermeldung

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread