Excel an Word
29.09.2008 12:05:00
Volker
ich haben mir folgenden Code gesucht und für meine Bedürfnisse angepasst.
Soweit funktioniert er auch wie ich es möchte.
Allerdings würde ich mir wünschen, das der Code nach Eingabe in das letze Feld (Hier WAL)
Das Dokument unter dem inhalt der Textmarke (Name) und der Textmarke (Datum) als .doc auf Laufwerk C
abspeichert.
Ich bin für jeden Hinweis dankbar.
Gruß Volker
Hier der Code:
Private Const Pfad = "C:\Bestellungen\Bestellvordruck.doc" 'an diesem ort liegt das Worddokument,
'die Position des Exceldokumentes ist beliebig
Private wdAnw As Object
Private wdDok As Object
Sub WordMitBestehendemDokumentStarten()
On Error Resume Next
Set wdAnw = GetObject(, "Word.Application") 'Bestehende Word-Instanz suchen
Select Case Err.Number
Case 0 'Alles paletti
Case 429 'Es gibt soweit keine Word-Instanz
Err.Clear
Set wdAnw = CreateObject("Word.Application") 'Word-Instanz erzeugen
If Err.Number > 0 Then
BadOrHappyEnd Err.Number, Err.Description
Exit Sub
End If
Case Else 'Unerwarteter Fehler
BadOrHappyEnd Err.Number, Err.Description
Exit Sub
End Select
On Error GoTo 0
wdAnw.Visible = True 'Instanz sichtbar machen
wdAnw.WindowState = 0
'Je nach dem, ob das Dokument bereits geöffnet ist oder nicht wird verbunden
'bzw. geöffnet. Diese Differenzierung geschieht implizit.
On Error Resume Next
Set wdDok = wdAnw.Documents.Open(Filename:=Pfad)
If Err.Number > 0 Then 'Wenn Arbeitsmappe nicht _
existiert oder unerwarteter Fehler
BadOrHappyEnd Err.Number, Err.Description
Exit Sub
End If
On Error GoTo 0
'eigentliche Codeausführung
'jetzt können die Felder im Word gefüllt werden
wdAnw.ActiveDocument.FormFields.Item("Firma").Result = Cells(1, 1)
wdAnw.ActiveDocument.FormFields.Item("Name").Result = Cells(2, 1)
wdAnw.ActiveDocument.FormFields.Item("Anschrift").Result = Cells(3, 1)
wdAnw.ActiveDocument.FormFields.Item("PLZ").Result = Cells(4, 1)
wdAnw.ActiveDocument.FormFields.Item("Ort").Result = Cells(5, 1)
wdAnw.ActiveDocument.FormFields.Item("Land").Result = Cells(6, 1)
'Bis hierhin Anschrift
wdAnw.ActiveDocument.FormFields.Item("esberät").Result = Cells(1, 8) 'Es berät Sie
wdAnw.ActiveDocument.FormFields.Item("Telefon").Result = Cells(2, 8) 'Telefon
wdAnw.ActiveDocument.FormFields.Item("Telefax").Result = Cells(3, 8)
wdAnw.ActiveDocument.FormFields.Item("email").Result = Cells(4, 8) 'EMail
wdAnw.ActiveDocument.FormFields.Item("IhrZeichen1").Result = Cells(5, 8)
wdAnw.ActiveDocument.FormFields.Item("IhrZeichen2").Result = Cells(6, 8)
wdAnw.ActiveDocument.FormFields.Item("MeinZeichen1").Result = Cells(7, 8)
wdAnw.ActiveDocument.FormFields.Item("MeinZeichen2").Result = Cells(8, 8)
wdAnw.ActiveDocument.FormFields.Item("Datum").Result = Cells(9, 8)
wdAnw.ActiveDocument.FormFields.Item("Text47").Result = Cells(9, 9) 'Unterzeichner
'Bis hierhin Kopf
wdAnw.ActiveDocument.FormFields.Item("Artikel01").Result = Cells(13, 1)
wdAnw.ActiveDocument.FormFields.Item("Menge01").Result = Cells(13, 2)
wdAnw.ActiveDocument.FormFields.Item("EPreis01").Result = Cells(13, 3)
wdAnw.ActiveDocument.FormFields.Item("GPreis01").Result = Cells(13, 4)
'Bis hierhin Artikel 01
soweiter bis 14
wdAnw.ActiveDocument.FormFields.Item("Nettopreis").Result = Cells(27, 4) ' Summe vor Steuer
wdAnw.ActiveDocument.FormFields.Item("MWSTPreis").Result = Cells(28, 4) ' Summe MWSt
wdAnw.ActiveDocument.FormFields.Item("Bruttopreis").Result = Cells(30, 4) 'Gesamtsumme
wdAnw.ActiveDocument.FormFields.Item("WAL").Result = Cells(10, 8)
End Sub