Word Tabelle mit vba bearbeiten
09.05.2020 17:39:45
JZ2000
Also ich erstelle mit Excel VBA eine Word Datei aus einer Vorlage heraus.
Einige Daten Übertrage ich mit Bookmarks.
Ich habe jedoch in der Vorlage auch eine Tabelle, welche ich bei bedarf erweitern möchte.
Weiß jemand wie ich das aus Excel VBA heraus mache? (Die Daten kommen aus einer Userform mit dem name "Angebot"
Hier mal was ich bis jetzt habe, das relevante ist FETT:
Sub Angebotexportieren()
Dim Ordername As String
Dim Ordnerneu As String
Ordnername = VBA.FileSystem.Dir(ThisWorkbook.Path & "\Datenbank\Dokumente\" & Right(Angebot. _
Angebotsnummer.Value, Len(Angebot.Angebotsnummer.Value) - 2) & "-" & Angebot.Projektname.Value)
Ordnerneu = ThisWorkbook.Path & "\Datenbank\Dokumente\" & Right(Angebot.Angebotsnummer.Value, _
Len(Angebot.Angebotsnummer.Value) - 2) & "-" & Angebot.Projektname.Value
If Ordnername = VBA.Constants.vbNullString Then
MkDir (Ordnerneu)
End If
Dim appWord As Object
Dim Angebotdoc As Object
Set appWord = CreateObject("Word.Application")
Set Angebotdoc = appWord.Documents.Add(ThisWorkbook.Path & "\Vorlagen\New\01_Mustervorlage - _
Angebot.docx")
'appWord.Visible = True
'Angebot.doc.Activate
'Agebots Daten
Angebotdoc.Bookmarks("Sachbearbeiter").Range.Text = Application.Username
Angebotdoc.Bookmarks("Angebotsdatum").Range.Text = Date
Angebotdoc.Bookmarks("Kundennummer").Range.Text = Angebot.Kundennummer.Value
Angebotdoc.Bookmarks("Anprechpartner").Range.Text = Angebot.Anrede.Value & " " & Angebot. _
Nachname.Value
Angebotdoc.Bookmarks("Handynummer").Range.Text = Angebot.Mobil.Value
Angebotdoc.Bookmarks("Festnetznummer").Range.Text = Angebot.Festnetz.Value
Angebotdoc.Bookmarks("EMailKunde").Range.Text = Angebot.Email.Value
Angebotdoc.Bookmarks("Projektname").Range.Text = Angebot.Projektname.Value
Angebotdoc.Bookmarks("Angebotsart").Range.Text = Angebot.Angebotsart.Value
Angebotdoc.Bookmarks("StartDatum").Range.Text = Angebot.Startdatum.Value
Angebotdoc.Bookmarks("EndDatum").Range.Text = Angebot.Enddatum.Value
Angebotdoc.Bookmarks("Lieferungsart").Range.Text = Angebot.Lieferart.Value
'Angebots Briefkopf
Angebotdoc.Bookmarks("Firma").Range.Text = Angebot.Firma.Value
Angebotdoc.Bookmarks("Name").Range.Text = Angebot.Vorname.Value & " " & Angebot.Nachname. _
Value
Angebotdoc.Bookmarks("Straße").Range.Text = Angebot.Straße.Value
Angebotdoc.Bookmarks("PLZOrt").Range.Text = "D " & Angebot.Postleitzahl.Value & " " & _
Angebot.Ort.Value
'Angebots Nachricht
Angebotdoc.Bookmarks("Nachricht").Range.Text = Angebot.Nachricht.Value
Angebotdoc.SaveAs Ordnerneu & "\" & Angebot.Angebotsnummer.Value & ".docx"
Set Angebotdoc = Nothing
Set appWord = Nothing
End Sub