Aus Excel ein Word Dokument erstellen.

[Sven]

Hallo zusammen,

ich habe da ein Problem und weis keinen Ansatz.

Ich benutze  Office 2010. 
Mein Problem ist, ich habe eine gut gefüllte Excel Tabelle und möchte aus dieser aus jeder Spalte ein Feld A in einem Word Dokument Exportieren. Im zweiten Schritt soll das Feld B (der gleichen Zeile) als Dateiname gespeichert werden. Und das Spalte für Spalte und das am besten automatisch. 

Ist sowas möglich? Wenn ja wie?
Ich bedanke mich schon mal vorab.  
Gruß Sven

[snb]

Kein Problem.


Ohne Beispieldatei doch.

Aber: wozu ?

[Sven]

Zweck ist den Text in einer Datenbank als Word Dokument abzuspeichern.

Die Summe ist das Problem es sind mehrer E. Dateien mit bis zu 500 Zeilen. 
ich komme so auf ca. 10000 Word Dateien. 

Spalte A soll der W. Datei Name sein und Spalte B der Text für das Word Dokument.

[schauan]

Hallöchen,

das könnte mit diesem Makro funktionieren. Als Speicherverzeichnis habe ich F:\Test programmiert, muss ggf. geändert werden.

Code:

Sub Excel2Word()
'getestet unter 2016
'Variablendeklaration
'Objekte
Dim appWord As Object
Dim objFile As Object
'Array
Dim arrDaten
'Word-Application erzeugen
Set appWord = CreateObject("Word.Application")
'Daten von A2 bis Bxxx in Array uebernehmen
arrDaten = ActiveSheet.Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 2)).Value
'Schleife ueber alle Inhalte des Array
For icnt = 1 To UBound(arrDaten, 1)
  'Datei erzeugen
  Set objFile = appWord.Documents.Add
    'Datei aktivieren - kann eventuell entfallen
    objFile.Activate
    'Text zuweisen
    appWord.Selection.Text = arrDaten(icnt, 2)
    'speichern unter ...
    objFile.SaveAs2 Filename:="F:\Test\" & arrDaten(icnt, 1), FileFormat:= _
        wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
        :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
        :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False, CompatibilityMode:=15
    'Datei schließen und zuruecksetzen
    Set objFile = Nothing
'Ende Schleife ueber alle Inhalte des Array
Next
'Word-Objekt zuruecksetzen
Set appWord = Nothing
End Sub

[snb]

Mit etwas weniger Code geht's auch:

Code:

Sub M_snb()
  sn = Sheet1.Cells(1).CurrentRegion

  With CreateObject("Word.application")
    For j = 2 To UBound(sn)
      With .documents.Add
        .Content = sn(j, 2)
        .Windows(1).Visible = True
        .SaveAs "G:\OF\" & sn(j, 1)
        .Close 0
      End With
    Next
  End With
End Sub