Erstellen neuer Exceldatei Vba
17.08.2016 15:15:02
Felix
ich habe folgendes Problem und konnte bisher keine passende Lösung finden.
Ich habe ein Kalkulationstool programmiert welches am Ende der Kalkulation alle Daten in eine Übersicht kopiert.
Durch klicken eines Buttons sollen nun 2 Datein erzeugt werden.
1. Eine Kopie des Kalkulationstools samt Makro (das funktioniert)
2. Eine neue Exceldatei welche 2 bestimmte Worksheets des Kalkulationstools beinhaltet.
Nun zum Problem:
Das Erstellen der Datei funktioniert zwar, allerding stürzt die erstelle Exceldatei aus Punkt 2 immer ab, wenn ich sie drucken möchte.
Dies passiert nicht nur an meinem Pc, sondern auch an anderen.
Anbei der Code:
Private Sub cmdSpeichern_Click()
Call Set_Zentral
'Name und Pfad des Excelsheets
wksName = ThisWorkbook.Name
pfad = ThisWorkbook.Path
'Deklaration der benötigten Tabellen
tab1 = "Kalkulationsdeckblatt"
tab2 = "Kommentare"
Entscheidung1 = MsgBox("Sie sind dabei die Kalkulation auf dem Server zu speichern!" & vbCrLf & _
"Wollen Sie fortfahren?", vbYesNo)
'Fortfahren
If Entscheidung1 = vbYes Then
Dim Kalk As Object
Dim Kalkdeckblatt As Object
Dim strPfad As String
Dim strBezeichnung As String
Dim strOrd As String
strPfad = wksEinstellungenBenutzer.Cells(2, 1)
strBezeichnung = "_" & wksKalkulationsdeckblatt.Cells(1, 12)
Ord = strPfad & "\" & Date & "_Kalkulation"
wksnamemappe = ThisWorkbook.Name
'Verzeichnis anlegen,bzw. prüfen ob bereits angelegt
If Dir(Ord, vbDirectory) = "" Then
MkDir (Ord)
MsgBox "Ordner " & Ord & " wurde angelegt!"
Else
MsgBox "Ordner " & Ord & " ist vorhanden!"
End If
'vollständige Kalk speichern
Workbooks(wksName).SaveCopyAs Filename:=Ord & "\" & Date & "_" & "_Kalkulation" & _
strBezeichnung & ".xlsm"
'Deckblatt erzeugen
Application.EnableEvents = False
Application.DisplayAlerts = False
Worksheets(Array(tab1, tab2)).Copy
ActiveWorkbook.SaveAs Filename:=Ord & "\" & Date & "_" & "_Kalkulationsdeckblatt" & ". _
xls"
(Hier muss der Fehler liegen...)
Workbooks(wksnamemappe).Close
ElseIf Entscheidung1 = vbNo Then
MsgBox ("Es hat kein Export auf den Server stattgefunden!")
End If
End Sub
gruss Felix