Excel Daten nach Word
22.07.2021 12:16:38
Klaus
Leider komme ich alleine nicht weiter. Mit der Lösung die mir JoWe im Forum übermittelt
hatte, komme ich nicht klar. Dazu habe ich leider zu wenig VBA Kenntnisse.
Zur Aufgabe:
Ich habe mehrere Word Dokumente, die mit Daten wie Name Vorname usw. gefüllt werden müssen
Vorab: die Word Formulare sind vorgegeben und können nicht gegen Dokumente ersetzt werden
die neu mit Excel erstellt werden.
Die Skripte die ich erstellt habe funktionieren und die Daten werden über Textmarken auch gefüllt.
Nun zu meinem Problem:
Wenn ich die Dokumente dann über PrintOut ausdrucke sind die Felder richtig gefüllt aber das
neu erstellte Dokument hat den Dateinamen Dokument1 .(Was ja auch so Standard in Windows ist,
wie mir bereits von einem Forum Mitglied geschrieben wurde) und der Dateiname
incl. Kopf- und Fußzeile der organisatorisch wichtig ist sind verschwunden.
Nun wollte ich das Dokument mit "saveas" erst in einem Ordner mit dem richtigen Namen speichern
Call docForum.SaveAs("C:\Forum\Einarbeitung Abteilung1 Mitarbeiter.docx")
Das funktioniert auch aber die Textmarken werden nun nicht mehr gefüllt.
(was habe ich hier falsch gemacht?)
Danach wollte ich über dieses Makro ein weiteres Makro aufrufen das Kopf- und Fußzeile
in dem gespeicherten Dokument richtig füllt und dann ausdruckt (S ub Abteilung1druck() weiter unten)
Manuell aufgerufen funktioniert dieses Makro nur über den Call Befehl wird es bei mit nicht gestartet.
Was mache ich da falsch?
Wenn das Dokument ausgedruckt ist, kann es aus dem Ordner C:\Forum gelöscht werden
Ich habe das mit Docx und Dotx Dokumenten probiert komme aber nicht weiter
Vielleicht kann mir ja jemand helfen und hat die zündende Idee Danke
hier nun die beiden Makros
Sub PersonalAbteilung1()
'Dimmensionieren der Zusatz Dokumente
Dim Zusatz1 As Object
Dim appWord As Object
Dim docForum As Object
'Umgebung allgemein
Set appWord = CreateObject("Word.Application")
'Umgebung der Zusatz Dokumentenvorlagen mit DOCX
Set Zusatz1 = appWord.documents.Add("C:\Forum\Personal-Dokumentenvorlagen\Einarbeitung\Einarbeitung Abteilung1 Mitarbeiter.docx")
Set docForum = appWord.documents.Add("C:\Forum\Personal-Dokumentenvorlagen\Einarbeitung\Einarbeitung Abteilung1 Mitarbeiter.docx")
'Umgebung der Zusatz Dokumentenvorlagen mit DOTX
'Set Zusatz1 = appWord.documents.Add("C:\Forum\Personal-Dokumentenvorlagen\Einarbeitung\Einarbeitung Abteilung1 Mitarbeiter.dotx")
'Set docForum = appWord.documents.Open("C:\Forum\Personal-Dokumentenvorlagen\Einarbeitung\Einarbeitung Abteilung1 Mitarbeiter.dotx")
'Set docForum = appWord.documents.Add("C:\Forum\Personal-Dokumentenvorlagen\Einarbeitung\Einarbeitung Abteilung1 Mitarbeiter.dotx")
'Setzen ob Dokument sichbar "True" oder nicht sichbar "False"
appWord.Visible = True
'Zusatz Dokumente aktivieren
Zusatz1.Activate
'Bookmarks Zusatz
Zusatz1.Bookmarks("Personalnummer").Range.Text = Range("Personalnummer")
Zusatz1.Bookmarks("Beschäftigungsbeginn").Range.Text = Range("Beschäftigungsbeginn")
Zusatz1.Bookmarks("Probezeitende").Range.Text = Range("Probezeitende")
Zusatz1.Bookmarks("Name").Range.Text = Range("Name")
' war aus den Tests habe ich optional drin gelassen
' Export als PDF falls benötigt
'Call docForum.ExportAsFixedFormat("Einarbeitung\Einarbeitung Abteilung1 Mitarbeiter.pdf")
' Speichern mit Daten aus einer Zelle falls benötigt
'Call docForum.SaveAs("C:\Forum\Einarbeitung Abteilung 1 Mitarbeiter.docx" & Cells(2, 1).Text, 12)
ActiveSheet.Unprotect
'Speichern als DOCX in einem Ordner
Call docForum.SaveAs("C:\Forum\Einarbeitung Abteilung1 Mitarbeiter.docx")
'Ausdrucken der Dokumente
'Funktioniert wird aber leider die benötigte vorgegebene Kopf und Fußzeile = Filename nicht gedruckt)
'Zusatz1.PrintOut
'Zusatz1.Close savechanges:=False
Aufruf des zweiten Makro funktioniert nicht
Call Abteilung1druck
appWord.Quit
Set Zusatz1 = Nothing
Set appWord = Nothing
Set docForum = Nothing
End Sub
Hier das zweite Makro das aus dem ersten heraus aufgerufen werden soll (Wurde aufgezeichnet)
Sub Abteilung1druck()
If ActiveWindow.View.SplitSpecial wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.Copy
ChangeFileOpenDirectory "C:\Forum\"
ActiveDocument.SaveAs FileName:= _
"Einarbeitung Abteilung1 Mitarbeiter.docx", _
FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
:=False, SaveAsAOCELetter:=False, CompatibilityMode:=14
Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentWithMarkup, Copies:=1, Pages:="", PageType:= _
wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=False, _
PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
ActiveWindow.Close
Application.Quit