Makro um aus Excel > Word Dokumente zu erstellen

Question

Nabend Leute

OK hier meine Frage.
Ich habe ein Excel Dokument und in einer Spalte sind verschiedene Zahlen. Ziel ist es für jede Zeile dieser Spalte ein Worddokument zu erstellen, in dessen Name die Zahl vorkommt.
Auch soll in dem Worddokument an einer bestimmten Stelle die Zahl erscheinen.
BSP:
Excel Spalte
|1|
|2|
|3|
|4|
|5|

Daraus sollen nun 5 Worddokumente erstellt werden mit den Namen
Beispielname Nr.1.doc
Beispielname Nr.2.doc
Beispielname Nr.3.doc
Beispielname Nr.4.doc
Beispielname Nr.5.doc

Und in jedem der Dokumente sollte es dann zb. eine Überschrift geben die heißt.
Das hier ist Dokument 1
Das hier ist Dokument 2
Das hier ist Dokument 3
Das hier ist Dokument 4
Das hier ist Dokument 5


Klingt irgendwie komisch und kompliziert.
Aber das sind über 300 verschiedene Zahlen, und für jedes brauche ich ein Worddokument. Das von Hand zu erledigen ist noch bescheuerter, als dafür ne automatische Lösung zu suchen.

Falls mir also jemand dabei Helfen könnte, oder ein Makro kennt, oder mir ne gute Site nennen könnte, auf der ich mich ersteinmal zum Thema Makros einlesen könnte, wäre mir schon geholfen.
Vielen Dank

mfg der-bettler

Answer 1

und hoch damit

mfg der-bettler

Answer 2

Hi,

Ich gehe mal davon aus, daß Du grundlegend mit Excel-Macros vertraut bist. Wenn ja, kannst Du einmal folgendes probieren bzw. als Denkanstoß verwenden:

Sub WDErstellung()
Dim objWA As Object, objWD As Object
Dim intRow As Integer
Dim lngCount As Integer
Dim strScratch As String, strText As String
Dim strPfad As String, strName As String

intRow = 1 'QuellSpalte (hier A)
strPfad = "C:\Test2\" 'Pfad muss in diesem Beispiel existieren
strText = "Das hier ist Dokument " 'zu schreibender Text
strName = "Beispielname Nr." 'Name der Dateien

Set objWA = CreateObject("Word.application") 'Word öffnen
'objWA.Visible = True 'falls man zuschauen möchte
With ThisWorkbook.ActiveSheet
For lngCount = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(lngCount, intRow).Value <> "" And IsNumeric(.Cells(lngCount, intRow).Value) Then
strScratch = .Cells(lngCount, intRow).Value
Set objWD = objWA.documents.Add
With objWA
.Selection.Font.Name = "Arial"
.Selection.Font.Size = 16
.Selection.Font.Underline = True
.Selection.TypeText Text:=strText & strScratch & " !"
End With
objWD.SaveAs (strPfad & strName & strScratch & ".doc") 'WD speichern
objWD.Close 'WD schließen
End If
Next lngCount
End With
objWA.Quit 'Word-Anwendung schliessen
End Sub

Bye

Answer 3

Hi,

ups... Der Einstieg in die FOR-Schleife ist falsch. Der bezieht sich immer auf SpalteA und sollte geändert werden in:

For lngCount = 1 To .Cells(Rows.Count, intRow).End(xlUp).Row
.
.
.
next lngCount

Bye

Answer 4

gute morgen

danke schoneinmal für das vba script
alleine das sollte mir schoneinmal viel zeit sparen
ich versuche das ganze nun noch etwas umzubauen
und zwar habe ich eine word vorlage, die ich dabei für jedes zu erstellende word verwenden möchte
und der text
"Das hier ist Dokument 2"
muss an eine bestimmte stelle

ich probiere einmal rum

danke

mfg der-bettler

Answer 5

so nochmal rückmeldung von mir
klappt nun alles so wie ich will

die vorlage kann man ja einfach temporär als normal.dot einbinden

den code habe ich dahingehened verändert, das er mit dem move befehl an die entsprechende stelle geht

Sub WDErstellung()
Dim objWA As Object, objWD As Object
Dim intRow As Integer
Dim lngCount As Integer
Dim strScratch As String, strText As String
Dim strPfad As String, strName As String

intRow = 14 'QuellSpalte (hier A)
strPfad = "C:\Test2\" 'Pfad muss in diesem Beispiel existieren
strText = "" 'zu schreibender Text
strName = "FRD " 'Name der Dateien

Set objWA = CreateObject("Word.application") 'Word öffnen
'objWA.Visible = True 'falls man zuschauen möchte
With ThisWorkbook.ActiveSheet
For lngCount = 1 To .Cells(Rows.Count, intRow).End(xlUp).Row
If .Cells(lngCount, intRow).Value <> "" And IsNumeric(.Cells(lngCount, intRow).Value) Then
strScratch = .Cells(lngCount, intRow).Value
Set objWD = objWA.documents.Add
With objWA
.Selection.Move Count:=37
.Selection.Delete Count:=9
.Selection.Font.Name = "Calibri"
.Selection.Font.Size = 16
.Selection.Font.Underline = False
.Selection.TypeText Text:=strText & strScratch
End With
objWD.SaveAs (strPfad & strName & strScratch & ".doc") 'WD speichern
objWD.Close 'WD schließen
End If
Next lngCount
End With
objWA.Quit 'Word-Anwendung schliessen
End Sub




von daher nochmals vielen dank für den code und die anregung

mfg der-bettler

Answer 6

Hi,

Dann sollten die ca. 300 Dateien ja schon fertig sein. ;-)

Kleiner Nachtrag:

Neues Doc auf der Basis einer anderen Vorlage als normal.dot liesse sich erledigen wie folgt:

Set objWD = objWA.documents.Add("meineVorlage.dot")

Oder, wenn es keine "echte" Vorlage ist, kannst Du auch ein WordDoc öffnen, welches als Basis dienen soll. Das könnte dann so aussehen:

Set objWD = objWA.documents.Open("E:\Test\meineDatei.doc")

Bye

Answer 7

huhu

danke noch für das nachreichen der vorlage
so muss man seine normal.dot nicht ersetzten
vielen dank nochmals

mfg der-bettler

Answer 8

diese Lösung hat mich SEHR geholfen.
Eine offene Frage... Wie kann ich den Zeilenabstand (line-space) auf 0 setzen?

George