Office: Daten aus Excel nach Word transferieren

Raphael-2017 · 9. Januar 2017

Hallo Excel-Foren-Mitglieder,

wie üblich, wenn hier jemand etwas schreibt, geht es um ein Problem das nicht (zumindest von mir) gelöst werden kann!

Informationen: das Problem besteht unter Windows 7 mit Excel 2013 ( 32 Bit ) und unter Windows 10 mit Excel 2016 ( 64 Bit ). Andere Systeme stehen mir nicht zur Verfügung.
Es handelt sich um eine .xlsm Excel-Datei.

Jetzt zu meinem Problem:
Ich habe hier eine Datei in welcher ich in jeder Zeile ein Gerät eintrage und zu jedem dieser Geräte in die Spalten verschiedene Informationen ( insgesamt ca. 70 Spalten ). So z.B. Seriennummer / Equipmentnummer / Typ / wo verbaut / usw..
Für jedes Gerät werden nun verschiedene Dokumente ausgedruckt. Bisher habe ich diese Dokumente händisch ausgefüllt. Bei den Dokumenten handelt es sich sowohl um Excel- als auch um Word-Dokumente.
Jetzt war mein Gedanke dies zu Automatisieren.
Mein Wunsch wäre nun, dass ich in dem Exel-file auf eine beliebige Zelle klicke und nun via Makro die benötigten Informationen ( nenne wir Sie Typ / Equipmentnummer / Ort ) aus dieser Zeile kopiere, sich das Word-Formular öffnet und diese Informationen dort, an vordefinierten Stellen, eingefügt werden.
Leider schaffe ich es nicht die Daten aus Excel in das Word-Dokument zu bekommen.
Folgenden Code habe ich bis jetzt im Einsatz:
Code:

Public Function CE_Erklaerung()
'großer versuch
Dim appWord As Object
Dim doc As Object
Dim wks As Worksheet
Dim WordObj As Object
Dim AdresseCE As String
Dim neueAdresseCE As String
Dim EQNR As String

'*** Tabelle aktivieren ***
ThisWorkbook.Worksheets("CCS-2016").Activate

'*** Aktive Zeile auslesen ***
AdresseCE = ActiveCell.AddressLocal(False, False)
neueAdresseCE = Mid(AdresseCE, 2)

'*** Word starten ***
Set appWord = CreateObject("Word.Application")

'*** verwendet Datei nur als Vorlage ***
'Set doc = appWord.Documents.Add("C:DeinPfadAngebot.doc")

'*** öffnet die Datei selbst ***
'Set doc = appWord.Documents.Open("file://rtlxsmb1.rt.de.bosch.com/share/tef7w/CCS/09_CE/00_Vorlage_2016_CCS_Konformitätserklärung_TEST.docm")
Set doc = appWord.Documents.Open("E:120 - Maschinenbuch0_Vorlage_2016_CCS_Konformitätserklärung_TEST.docm")

'***
Set WordObj = GetObject(, "Word.Application")
If WordObj Is Nothing Then
Set WordObj = CreateObject("Word.Application")
Else
End If

'*** Word sichtbar machen ***
appWord.Visible = True

'*** falls das Dokument geschützt ist ***
'doc.Unprotect

'*** Anspringen einer Textstelle in Word mittels Textmarke ***
'*** Prüfen ob diese existiert ***
'*** Den Wert aus Tabelle "CCS-2016" Zelle "T" an Textmarke einfügen ***
If WordObj.ActiveDocument.Bookmarks.Exists("EQNR") Then
With WordObj.Selection
.Goto what:=wdGoToBookmark, Name:="EQNR"
.TypeText Worksheets("CCS-2016").Range("T" & neueAdresseCE).Value
End With
Else
MsgBox "Die Textmarke [EQNR] ist nicht vorhanden"
End If

'*** Aufräumen ***
Set WordObj = Nothing

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Könnt Ihr mir hier bitte helfen? Das Problem ist, das die Daten nicht eingetragen werden bzw. an einer ganz anderen Stelle. Evtl. bin ich auch zu ungeschickt im Umgang mit Word. Das erstellen einer Textmarke will mir nicht gelingen, bzw. werden dorthin keine Daten geschrieben.
Wie können wir das Problem lösen.
Schon einmal vielen Dank fürs lesen und helfen.
P.S.: Da nichts im Leben umsonst ist, würde Ich auch eine gute Flasche Wein spenden ( sofern der Helfer ü18 ist ).

MfG
Raphael

:)

EarlFred · 10. Januar 2017

Hallo Raphael,

auch ohne Wein (aber tolles Angebot!):
Code:

Option Explicit

Public Function CE_Erklaerung()
'großer versuch
Dim appWord As Object 'Word-Instanz
Dim wdDoc As Object 'Word-Document
Dim wdRng As Object 'Word-Range

Dim wks As Worksheet
Dim neueAdresseCE As Long
Dim EQNR As String

'*** Tabelle aktivieren ***
ThisWorkbook.Worksheets("CCS-2016").Activate 'wozu?

'*** Aktive Zeile auslesen ***
neueAdresseCE = ActiveCell.Column

'*** Word starten ***
Set appWord = CreateObject("Word.Application")

'*** öffnet die Datei selbst ***
Set wdDoc = appWord.Documents.Open("E:120 - Maschinenbuch0_Vorlage_2016_CCS_Konformitätserklärung_TEST.docm")

'*** Word sichtbar machen ***
appWord.Visible = True

'*** falls das Dokument geschützt ist ***
'doc.Unprotect

'*** Anspringen einer Textstelle in Word mittels Textmarke ***
'*** Prüfen ob diese existiert ***
'*** Den Wert aus Tabelle "CCS-2016" Zelle "T" an Textmarke einfügen ***
If wdDoc.Bookmarks.Exists("EQNR") Then
With wdDoc.Bookmarks("EQNR")
Set wdRng = .Range
wdRng.Text = Worksheets("CCS-2016").Range("T" & neueAdresseCE).Value
wdDoc.Bookmarks.Add "EQNR", wdRng
End With
Else
MsgBox "Die Textmarke [EQNR] ist nicht vorhanden"
End If

'*** Aufräumen ***

'Dokument speichern? Schließen? App schließen?

Set wdRng = Nothing
Set wdDoc = Nothing
Set appWord = Nothing
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Die Backslashs \ werden hier verschluckt - bitte wieder eintragen.

Grüße
EarlFred

Raphael-2017 · 11. Januar 2017

Hallo EarlFred,

danke für's Lesen. Hier der Code mit den fehlenden Backslashes.
Code:

Public Function CE_Erklaerung()
'großer versuch
Dim appWord As Object
Dim doc As Object
Dim wks As Worksheet
Dim WordObj As Object
Dim AdresseCE As String
Dim neueAdresseCE As String
Dim EQNR As String

'*** Tabelle aktivieren ***
ThisWorkbook.Worksheets("CCS-2016").Activate

'*** Aktive Zeile auslesen ***
AdresseCE = ActiveCell.AddressLocal(False, False)
neueAdresseCE = Mid(AdresseCE, 2)

'*** Word starten ***
Set appWord = CreateObject("Word.Application")

'*** verwendet Datei nur als Vorlage ***
'Set doc = appWord.Documents.Add("C:/DeinPfad/Angebot.doc")

'*** öffnet die Datei selbst ***
'Set doc = appWord.Documents.Open("file://rtlxsmb1.rt.de.bosch.com/share/tef7w/CCS/09_CE/00_Vorlage_2016_CCS_Konformitätserklärung_TEST.docm")
Set doc = appWord.Documents.Open("E:/120 - Maschinenbuch/00_Vorlage_2016_CCS_Konformitätserklärung_TEST.docm")

'***
Set WordObj = GetObject(, "Word.Application")
If WordObj Is Nothing Then
Set WordObj = CreateObject("Word.Application")
Else
End If

'*** Word sichtbar machen ***
appWord.Visible = True

'*** falls das Dokument geschützt ist ***
'doc.Unprotect

'*** Anspringen einer Textstelle in Word mittels Textmarke ***
'*** Prüfen ob diese existiert ***
'*** Den Wert aus Tabelle "CCS-2016" Zelle "T" an Textmarke einfügen ***
If WordObj.ActiveDocument.Bookmarks.Exists("EQNR") Then
With WordObj.Selection
.Goto what:=wdGoToBookmark, Name:="EQNR"
.TypeText Worksheets("CCS-2016").Range("T" & neueAdresseCE).Value
End With
Else
MsgBox "Die Textmarke [EQNR] ist nicht vorhanden"
End If

'*** Aufräumen ***
Set WordObj = Nothing

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Hoffentlich bleiben Sie diesesmal sichtbar. Im "Modul" sind Sie jedenfalls vorhanden. :-)

Das Angebot steht auf alle fälle und ist auch ernst gemeint ( das mit dem Wein ) .

Raphael-2017 · 11. Januar 2017

Hallo EarlFred,

ich dummkopf, habe Deine Antwort nicht verstanden ... das liebe alter.

Vielen lieben Dank ... werde esgleich testen ... mea culpa

LG
Raphael

Raphael-2017 · 12. Januar 2017

Hallo nochmal,

Dein Code funktioniert hervorragend.
Vielen Dank dafür.
Wenn Du mir Deine Adresse gibst, sende ich Dir gerne die Falsche Wein oder Ramazotti oder eine große Tüte Gummibären zu :-)

Jetzt hast Du mich auf den Geschmack gebracht das ganze weiter zu Optimieren. Evtl. könntst Du mir dabei etwas helfen.

Die Word Datei soll ausgedruckt werden und danach ohne zu speichern geschlossen werden.

Code:

Public Function CE_Erklaerung()

Dim appWord As Object 'Word-Instanz
Dim wdDoc As Object 'Word-Document
Dim wdRngE As Object 'Word-Range
Dim wdRngR As Object
Dim wdRngC As Object
Dim wdRngCN As Object

Dim wks As Worksheet
Dim AdresseCE As String
Dim neueAdresseCE As Long
Dim EQNR As String
Dim RPAM As String
Dim CCS As String
Dim CCSNR As String

'*** Tabelle aktivieren ***
'ThisWorkbook.Worksheets("CCS-2016").Activate 'wozu? ---- gute frage, auf die ich keine Antwort habe. Dachte immer das wäre nötig.

'*** Aktive Zeile auslesen ***
'neueAdresseCE = ActiveCell.Column ' ich benötige nur die Zeilen-Nummer ohne die Spaltenbezeichnung
AdresseCE = ActiveCell.AddressLocal(False, False)
neueAdresseCE = Mid(AdresseCE, 2)

'*** Word starten ***
Set appWord = CreateObject("Word.Application")

'*** öffnet die Datei selbst ***
Set wdDoc = appWord.Documents.Open("J:120 - Maschinenbuch0_Vorlage_2016_CCS_Konformitätserklärung_TEST.docm")

'*** Word sichtbar machen ***
appWord.Visible = True

'*** falls das Dokument geschützt ist ***
'doc.Unprotect

'*** Anspringen einer Textstelle in Word mittels Textmarke ***
'*** Prüfen ob diese existiert ***
'*** Den Wert aus Tabelle "CCS-2016" Zelle "T" an Textmarke einfügen ***
If wdDoc.Bookmarks.Exists("EQNR") Then
With wdDoc.Bookmarks("EQNR")
Set wdRngE = .Range
wdRngE.Text = Worksheets("CCS-2016").Range("T" & neueAdresseCE).Value
wdDoc.Bookmarks.Add "EQNR", wdRngE
End With
Else
MsgBox "Die Textmarke [EQNR] ist nicht vorhanden"
End If

'*** Den Wert aus Tabelle "CCS-2016" Zelle "G" in Textmarke "RPAM" einfügen ***
If wdDoc.Bookmarks.Exists("RPAM") Then
With wdDoc.Bookmarks("RPAM")
Set wdRngR = .Range
wdRngR.Text = Worksheets("CCS-2016").Range("G" & neueAdresseCE).Value
wdDoc.Bookmarks.Add "RPAM", wdRngR
End With
Else
MsgBox "Die Textmarke [RPAM] ist nicht vorhanden"
End If

'*** Den Wert aus Tabelle "CCS-2016" Zelle "J" in Textmarke "CCS" einfügen ***
If wdDoc.Bookmarks.Exists("CCS") Then
With wdDoc.Bookmarks("CCS")
Set wdRngC = .Range
wdRngC.Text = Worksheets("CCS-2016").Range("J" & neueAdresseCE).Value
wdDoc.Bookmarks.Add "CCS", wdRngC
End With
Else
MsgBox "Die Textmarke [CCS] ist nicht vorhanden"
End If

'*** Den Wert aus Tabelle "CCS-2016" Zelle "E" in Textmarke "CCS-Nr" einfügen ***
If wdDoc.Bookmarks.Exists("CCSNR") Then
With wdDoc.Bookmarks("CCSNR")
Set wdRngCN = .Range
wdRngCN.Text = Worksheets("CCS-2016").Range("E" & neueAdresseCE).Value
wdDoc.Bookmarks.Add "CCS", wdRngCN
End With
Else
MsgBox "Die Textmarke [CCSNR] ist nicht vorhanden"
End If

'*** Aufräumen ***

'Dokument speichern? Schließen? App schließen?
'drucken??????
'doc.Close '*** das Dokument schließen ohne zu speichern ***
'appWord.Quit '*** Word beenden ***

Set wdRngE = Nothing
Set wdRngR = Nothing
Set wdRngC = Nothing
Set wdRngCN = Nothing
Set wdRng = Nothing
Set wdDoc = Nothing
Set appWord = Nothing

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Habe den Code etwas angepasst. Danke nochmals fürs Lesen und Helfen.

LG
Raphael

EarlFred · 12. Januar 2017

Hallo Raphael,

vielen Dank für das Angebot. Es mangelt mir weder an Wein, Ramazotti noch Gummibärchen - aber ich finde es toll, dass Du eine Gegenleistung überhaupt anbietest. Wenn Du wirklich was gutes tun willst, spende das gleiche Geld lieber, z. B. an Wikipedia oder die Tafel in Deiner Stadt.

Ungetestet:
Code:

'Dokument speichern? Schließen? App schließen?
'drucken??????
'doc.Close '*** das Dokument schließen ohne zu speichern ***
'appWord.Quit '*** Word beenden ***

wdDoc.PrintOut
wdDoc.Close savechanges:=False
appWord.Quit
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Grüße
EarlFred

Raphael-2017 · 12. Januar 2017

Hallo EarlFred,

vielen lieben Dank für Deine Unterstützung.
Dir und Deiner Familie eine gute Zeit und vor allem Gesundheit.

Die Tafeln bekommen von uns 1x Quartal eine Zuwendung (Sachspenden).

Werde den Betrag an den Verein "hilfe für Krebskranke Kinder" spenden.

LG und ein schönes Wochenende
Raphael

Office: Daten aus Excel nach Word transferieren

Daten aus Excel nach Word transferieren

Daten aus Excel nach Word transferieren

Daten aus Excel nach Word transferieren

Daten aus Excel nach Word transferieren - Similar Threads - Daten Excel Word

Daten aus Excel nach Word

[Excel, VBA] Daten aus Excel-Bereich in Word Tabelle einfügen

Dropdownelement in Word mit Daten aus Excel füllen

Word Formularfelder mit Daten aus Excel befüllen

Word/Excel Formulare mit dynamischen Abruf von Daten aus geschlossenen Excel Dateien

Daten importieren aus Textdatei oder Word

Serienbrief mit Daten aus einer Exceltabell