VBA Serienbrief Excel zu Word
18.11.2021 11:06:56
Gabriel
Ich habe eine Exceldatenbank. Aus dieser lasse ich einen Serienbrief in Word erstellen. Nun habe ich folgendes Problem:
- Wenn ich die Daten in Word manuell importiere (mit dem Excelblatt geschlossen) funktioniert alles super. die formatierten Werte (zB "+- 1K", "1000 °C", "36:00", "17.11.2021") werden wie sie sind importiert und im Serienbrief angezeigt.
- Wenn ich die Daten in Word manuell importiere (mit dem Excelblatt offen) werden nur die Werte eingefügt und die Formatierung entfernt (zB 1", "1000", "1.5", "44517"). Zudem scheinen sie als Text importiert zu werden, wodurch sie auch nicht via Mailmerge Funktionen (zB "\@ "dd.MM.yyyy"") modifizierbar sind.
- Wenn ich die Daten aus Excel direkt mittels VBA sende (Code bei Bedarf anbei), ist das verhalten genau gleich.
- Wenn ich die Daten im Excel direkt als Text schreibe (zB "'+- 1K", "'1000 °C", "'36:00", "'17.11.2021") ist das Problem gelöst und tritt nicht mehr auf.
Nun meine Fragen:
Wie kann ich alle Werte einer Tabelle mitsamt dem Format kopieren (also "+- 1K" und nicht nur 1) und als Text einfügen (habe zwei Varianten anbei probiert, die nicht funktioniert haben)? Gibt es auch die Möglichkeit die formatierten Werte an Word zu schicken?
Danke im Voraus!
Beste Grüsse Gabriell
Seriebrieferstellung:
'die Anzahl der Positionen defininieren
Dim n As Long
n = Worksheets("Eingabemaske").Range("BX2").Value + 1 'Zeilen aus der Anzahl der Positionen bestimmen
'Nach Sachbearbeiter den LS (x bzw. y auswählen)
Dim Bearbeiterstandort As String
Bearbeiterstandort = Application.International(xlDecimalSeparator)
If InStr(Bearbeiterstandort, ".") > 0 Then
strSerienbrief1 = "Sinterauftrag PUNKT"
ElseIf InStr(Bearbeiterstandort, ",") > 0 Then
strSerienbrief1 = "Sinterauftrag KOMMA"
Else
MsgBox "Support kontaktieren"
End If
'Serienbrief1
strLaufwerkDateiname = ThisWorkbook.Path & "\Serienbriefvorlagen\" & strSerienbrief1 & ".docx" 'Pfad und Dateinamen zusammenfügen
Set oWord = CreateObject("word.application")
Set oDoc = oWord.Documents.Open(strLaufwerkDateiname)
oWord.Visible = True
oWord.Application.Activate 'Dokument wird in den Vordergrund geholt
oDoc.MailMerge.MainDocumentType = 0 'wdFormLetters = 0. Gibt einen Typ von Seriendruckdokument an.
oDoc.MailMerge.OpenDataSource Name:= _
ThisWorkbook.FullName _
, ConfirmConversions:=False, LinkToSource:=True, Connection:= _
"Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & _
ThisWorkbook.FullName & _
";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Je" _
, SQLStatement:="SELECT * FROM `Eingabemaske$`", SQLStatement1:="", SubType:=1 'hier das Blatt ändern
With oDoc.MailMerge
.Destination = 0 'wdSendToNewDocument = 0. Die Ergebnisse werden aus dem Serienbrief in ein neues Dokument übertragen.
.SuppressBlankLines = True 'Wenn Seriendruckfelder leer sind, werden die leere Zeilen im Seriendruckdokument unterdrückt.
With .DataSource
.FirstRecord = 1 'wdDefaultFirstRecord = 1. Aus dem Hauptdokument mit den Datensätzen 1 bis
.LastRecord = n 'wdDefaultLastRecord = -16. Zum letzten Datensatz zusammengeführt
End With
.Execute Pause:=False
End With
oDoc.Close SaveChanges:=0 'Das Seriendruckdokument wird ohne Speichern geschlossen
'Word Datei abspeichern
Dim dateiname As String
strLaufwerkDateiname2 = ThisWorkbook.Path & "\" 'Speicherpfad
teil1 = oWord.ActiveDocument.Words(1).Start 'Dateiname Start
teil2 = oWord.ActiveDocument.Words(2).End 'Dateiname Ende
dateiname = oWord.ActiveDocument.Range(teil1, teil2).Text 'Dateiname zusammensetzen
oWord.ActiveDocument.ExportAsFixedFormat outputfilename:=strLaufwerkDateiname2 & dateiname & ".pdf", exportformat:=wdExportFormatPDF 'PDF abspeichern
oWord.ActiveDocument.SaveAs2 Filename:=strLaufwerkDateiname2 & dateiname & ".docx" 'Word abspeichern
oWord.ActiveDocument.Close 'Datei schliessen
oWord.Application.Quit 'Word schliessen
Set oDoc = Nothing 'Dimension zurücksetzen
Set oWord = Nothing
Sheets("Eingabemaske").Range("b2:DA51") = Range("c52:Db102").Worksheet.Evaluate("index(text(B2:DA51,""'""),)")
Range("K2").Value = Format(Range("J2"), "&")