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
Kein Problem.
Ohne Beispieldatei doch.
Aber: wozu ?
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.
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
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