jobo: Word Rechnungstemplate füllen aus Excelzeile mit VBA

Beitrag lesen

Hallo,

Hallo,

am usabilsten wäre ja eigentlich eine makrogesteuerte Schweinerei, mit einem Button am Ende jeder Excelzeile (kriegt man den mit copy und paste rüber?) oder einem einzigen in der Tabelle (dann müsste die fragliche Zeile markiert sein), welches dann das passende Worddokument aufruft und die Zellen in die Vorlage einfügt (das würde ja theoretisch dann auch mit Suchen/Ersetzen gehen). Oder ist es (VBA-technisch) einfacher, die Rechnung statt in Word (so ist sie jetzt vorhanden und wird halt händisch bestückt) in Excel zu basteln?

Work in Progress sieht jetzt so aus:

  
Private Sub drucky_Click()  
'    MsgBox ActiveCell.Row  
    'MsgBox "aaa" & Cells(ActiveCell.Row, 2).Value  
Dim appWord As Object  
Dim docTest As Object  
Const wdMyReplaceAll = 2  
Dim ColName As String  
Dim Find As String  
Dim MyReplace As String  
Dim Name As String  
Dim Rechnnr As String  
Dim SaveAs As String  
  
' ist wohl Konstant der Einlesepfad  
Dim Pfad As String  
Pfad = ActiveWorkbook.Path & "\"  
  
Set objWord = CreateObject("Word.Application")  
objWord.Visible = True  
  
  
Set objDoc = objWord.Documents.Open(Pfad & "Vorlage.doc")  
Set objSelection = objWord.Selection  
  
'docTest.SaveAs (CreateObject("WScript.Shell").Specialfolders("Desktop") & "\test3")  
For i = 2 To ActiveSheet.UsedRange.Columns.Count  
ColName = Cells(1, i).Value  
Find = "{" & ColName & "}"  
MyReplace = Cells(ActiveCell.Row, i).Value  
If ColName = "netto" Or ColName = "brutto" Or ColName = "Steuer" Then  
MyReplace = Format(MyReplace, "#,##0.00")  
End If  
If ColName = "Name" Then  
Name = MyReplace  
End If  
If ColName = "Rechnnr." Then  
Rechnnr = Replace(MyReplace, "/", "-")  
End If  
objSelection.Find.Text = Find  
objSelection.Find.Forward = True  
objSelection.Find.MatchWholeWord = True  
  
objSelection.Find.Replacement.Text = MyReplace  
  
objSelection.Find.Execute , , , , , , , , , , wdReplaceAll  
Next  
SaveAs = Pfad & Rechnnr & "_" & Name  
objDoc.SaveAs (SaveAs)  
End Sub  

Gruß

jobo