AW: Tabelle in Word einfügen.
03.10.2023 19:11:26
JoWE
Daniele,
das zuvor Geschriebene ist Blödsinn, da habe ich mich mit einer anderen Anwendung verhaspelt, sorry.
Versuchs mit diesem Code (ersetze einfach den vorhanden "Private Sub Rechnung_DE_Click()")
mit dem folgenden:
Private Sub Rechnung_DE_Click()
'Achtung!! Zeilen und Spalten für die Word-TAbelle festlegen!!!
Dim WdZeilen As Long: WdZeilen = 4 'wieviele Zeilen soll die Word-Tabelle haben?
Dim WdSpalten As Long: WdSpalten = 6 'wieviele Spalten soll die Word-Tabelle haben?
Dim sp As Long 'sp ist der Schleifenzähler für das Formatieren der Textausrichtung in der Word-TAbelle
Dim RgZeile As Long
RZeile = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row 'hier wird die letzte gefüllte Zeile in Spalte A gefunden
'*********** Hier wird die Rechnung DE für CHF und Euro erstellt*********
'** Abfrage ob die erfassten Daten schon gespeichert wurden
If StatusButton_Speichern = 1 Then
GoTo N5
Else
MsgBox "Daten noch nicht gespeichert"
Exit Sub
End If
'** Sprungziel Daten wurden gespeichert
N5:
StatusButton_Speichern = 0
'************ Variablen belegen**************
'**Preis Erwachsene festlegen**
Preis_Erwachsene = 33#
'**Preis Kinder festlegen**
Preis_Kinder = 21#
'**Preis Porto festlegen**
Versand_Kosten = 5#
'**Preis Erwachsene festlegen**
Preis_Erwachsene_Euro = 33#
'**Preis Kinder festlegen**
Preis_Kinder_Euro = 21#
'**Preis Porto festlegen**
Porto_Barb_Euro = 5#
Arbeitsfolie = "GS Verkauf"
IngZeile = ActiveCell.Row
'*Word Application initialisieren
Set wordapp = CreateObject("Word.Application")
'** Word-Datei initialisieren und ein neues Dokument öffnen
'Set doc = wordapp.Documents.Open("C:\Users\dal\Desktop\QR_Rechnung_SSCT_Test.docx")
Set doc = wordapp.Documents.Open("G:\MeinExcel\Herbers Excel-Forum\Daniele_29092023\QR_Rechnung_SSCT_Test.docx")
'** Word sichtbar machen
wordapp.Visible = True
'** die offene Word-Datei unter neuem NAmen speichern
With doc
.SaveAs2 ThisWorkbook.Path & "\RG " & Rechnungs_Nr.Value & " " & Nachnamen.Value & ".docx"
'** die neue Word-Datei mit Excel-Daten befüllen
.Bookmarks("RG").Range.Text = Rechnungs_Nr.Value
.Bookmarks("Datum").Range.Text = Date
If Firma.Value = "" Then
.Bookmarks("Anrede").Range.Text = Anrede.Value
.Bookmarks("Anschrift").Range.Text = Vornamen.Value & " " & Nachnamen.Value
Else
.Bookmarks("Anrede").Range.Text = Firma.Value
.Bookmarks("Anschrift").Range.Text = Anrede.Value & " " & Vornamen.Value & " " & Nachnamen.Value
End If
.Bookmarks("Strasse").Range.Text = Strasse & " " & NR.Value
.Bookmarks("Ort").Range.Text = PLZ & " " & Ort.Value
.Bookmarks("Datum2").Range.Text = Datum.Value ' & " " & "/" & " " & TextKZ.Value
.Bookmarks("RG2").Range.Text = Rechnungs_Nr.Value
'************-- neue Word-Tabelle erstellen -- *************************
.Bookmarks("myBMNAme").Select 'Cursor an die Position der Textmarke "myBMName" setzen
'die neue Word-Tabelle erstellen an der aktuellen Cursor-Position, also an der Textmarke "myBMNAme"
.Tables.Add Range:=wordapp.Selection.Range, NumRows:=WdZeilen, NumColumns:=WdSpalten 'Zeilen und Spaltenanzahl angepasst?
Set wdTabelle = .Tables(doc.Tables.Count) 'die neue Tabelle(!!!) als Object "Table" definieren
With wdTabelle
'die relevanten Daten aus dem Excel-Tabellenbereich in die Word-Tabelle schreiben
'hier muss natürlich noch einiges an Deine Zielvorstellung angepasst werden
.Cell(1, 1) = "Datum"
.Cell(1, 2) = "RG.-Nr."
.Cell(1, 3) = "Preis"
.Cell(1, 4) = "Versand"
.Cell(1, 5) = "Porto/Bearbtg."
.Cell(1, 6) = "Kosten"
.Cell(2, 1) = Sheets("GS Verkauf").Cells(RgZeile + 1, 1).Text
.Cell(2, 2) = Sheets("GS Verkauf").Cells(RgZeile + 1, 4).Text
.Cell(2, 3) = Format(Preis_Erwachsene_Euro, "#,##0.00" & " ")
.Cell(2, 4) = Format(Versand_Kosten, "#,##0.00" & " ")
.Cell(2, 5) = Format(Porto_Barb_Euro, "#,##0.00" & " ")
.Cell(2, 6) = Format(Preis_Erwachsene_Euro + Versand_Kosten + Porto_Barb_Euro, "#,##0.00" & " ")
.Cell(3, 5) = "19% Mehrwertsteuer"
.Cell(3, 6) = Format((Preis_Erwachsene_Euro + Versand_Kosten + Porto_Barb_Euro) * 0.19, "#,##0.00" & " ")
.Cell(4, 5) = "Rechnungssumme"
.Cell(4, 6) = Format((Preis_Erwachsene_Euro + Versand_Kosten + Porto_Barb_Euro) * 1.19, "#,##0.00" & " ")
'** der Text in der ersten Zeile der Tabelle wird fett gedruckt
For sp = 1 To 6
.Cell(1, sp).Select
wordapp.Selection.Font.Bold = wdToggle
.Cell(4, sp).Select
wordapp.Selection.Font.Bold = wdToggle
Next
'** Die Spalten mit numerischen Werten rechtsbündig
For sp = 2 To 6
.Columns(sp).Select
wordapp.Selection.ParagraphFormat.Alignment = 2 'wdAlignParagraphRight
Next
'** in der Zeile der Gesamtsumme für die Optik die Zellen in Spalte 3 und 4 verbinden
.Cell(Row:=3, Column:=4).Merge MergeTo:=.Cell(Row:=3, Column:=5)
.Cell(Row:=4, Column:=4).Merge MergeTo:=.Cell(Row:=4, Column:=5)
End With
'** Cursor im Word-Dokument an den Anfang des Dokumentes setzen
wordapp.Selection.HomeKey Unit:=wdStory, Extend:=wdMove
'das neue Word-Dokument in den Vordergrund holen
wordapp.Activate
End With
'Userform schließen
Unload Me
'**Bild einfügen
'Set wrdPic = doc.Bookmarks("Bild").Range.InlineShapes.AddPicture("C:\Users\kaiwe\Desktop\Beispielbild.jpg")
'wrdPic.ScaleHeight = 10
'wrdPic.ScaleWidth = 10
'** Word-Datei schließen
'doc.Close SaveChanges:=False
'** Word-Applikation schließen
wordapp.Quit
End Sub
Gruß
Jochen