AutoText von Excel nach Word

Sub Word_Autotext() Dim appWord As Object Dim wdDoc As Object Dim i%, wert1, wert2 Dim leere_Zeile leere_Zeile = Sheets(1).Range("B" & Rows.Count).End(xlUp).Row Set appWord = CreateObject("Word.Application") Set wdDoc = appWord.Documents.Add appWord.Visible = True For i = 2 To leere_Zeile wert1 = Range("A" & i) wert2 = Range("B" & i) 'Hier geht es nicht mehr weiter appWord.NormalTemplate.AutoTextEntries.Add Name:=wert1, Range:=wert2 Next i appWord.Quit Set wdDoc = Nothing Set appWord = Nothing End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Robert,
Ich kann mich Reinhard nur anschliessen dass ich mich mit Word auch nicht so auskenne, aber Word verlangt als zweites Argument einen Bereich im Word Dokument, wohl den Bereich wo es den Autotext hinschreiben kann. Ein Range Objekt dafuer waere Selection.Range. Die AutoTextEntries funktionieren offenbar nicht so, dass Du da AAA reinschreibst und Word damit sagen kannst dass es BBBBBBBBBBBBBBBBB schreiben soll, sondern Du musst den Text schon genauso anfangen wie der Text am Ende aussehen soll, damit Word ihn erkennt. Also mit "Natuerl" z.B. fuer Dein Beispiel.
Was Du fuer Dein Beispiel braeuchtest waere die Autokorrektur, die Automatisch aus einem "blabla" ein "Natuerlich mein Schatz ich komme" macht. Die Syntax dafuer ist
appWord.AutoCorrect.Entries.Add Name:="blabla", Value:="Natuerlich mein Schatz ich komme".
Schoene Gruesse
Stefan

For i = 2 To letzte_Zeile wert1 = Range("A" & i) wert2 = Range("B" & i) appWord.Selection.TypeText Text:=wert2 appWord.Selection.HomeKey Unit:=wdStory, Extend:=wdExtend appWord.NormalTemplate.AutoTextEntries.Add Name:=wert1, Range:=appWord.Selection.Range '### appWord.NormalTemplate.AutoTextEntries.Add Name:=wert1, Range:=wert2 ' geht nicht Next i

Sub daten_holen() 'in datenqulle.xls existiert ein bereich mit namen "tab_1" 'im word dokument existiert eine tabelle mit genausovielen zeilen und spalten 'kann man aber auch dynamiscch machen Set kalkulation = GetObject("g:\datenquelle.xls") cc = kalkulation.Sheets(1).Range("tab_1") co = UBound(cc, 2) ro = UBound(cc, 1) For c = 1 To co 'titelspalte weglassen wäre 2 r = 1 For Each eineZelle In ActiveDocument.Tables(1).Columns(c).Cells() If cc(r, c) = "" Or cc(r, c) = "0" Then eineZelle.Range.Text = " " 'hier steht ein ALT255 damit's nach html passt Else eineZelle.Range.Text = cc(r, c) End If r = r + 1 Next eineZelle Next 'spalte End Sub

Hallo Werner
versuche maal folgendes aus word heraus zu starten, vorher eine tabelle mit den daten anlegen oder das macro entsprechend anpassen...
mfg gerd


Sub daten_holen()
'was ist word_autotext?, kenne ich nicht. wozu brauchst du das?
'dies ist ein word-macro, also nicht aus excel heraus starten sondern aus word
'um daten von excel nach word zu holen benutze ich immer diese methode
'in datenquelle.xls stehen deine texte, die du rüberbiemen willst
Set kalkulation = GetObject("L:\zwischenlager\datenquelle.xls") 'hier pfad und dateiname anpassen
cc = kalkulation.Sheets(1).Range("A1:B5") 'interessierenden datenbereich in array einlesen
co = UBound(cc, 2) 'anzahl spalten ermitteln (muß hier 2 sein wegen A1:B5)
ro = UBound(cc, 1) 'anzahl zeilen ermitteln (muß hier 5 sein wegen A1:B5)
Documents.Add DocumentType:=wdNewBlankDocument 'neues dokument erzeugen oder das wo der text hin soll activieren
'Documents("Ziel.doc").Activate
'jetzt entsprechend der quelle eine tabelle erzeugen oder eine bereits vorhandene verwenden
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=ro, NumColumns:= _
co, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
For c = 1 To co 'spaltenweise auslesen
r = 1
For Each eineZelle In ActiveDocument.Tables(1).Columns(c).Cells() 'jede zelle in der spalte
eineZelle.Range.Text = cc(r, c) 'inhalt aus dem array reinschreiben
r = r + 1
Next
Next
End Sub

Sub Word_Autotext() Dim appWord As Object Dim wdDoc As Object Dim i%, wert1, wert2 Dim leere_Zeile Const wdStory = 6 Const wdExtend = 1 leere_Zeile = Sheets(1).Range("B" & Rows.Count).End(xlUp).Row Set appWord = CreateObject("Word.Application") Set wdDoc = appWord.Documents.Add appWord.Visible = True For i = 2 To leere_Zeile wert1 = Range("A" & i) wert2 = Range("B" & i) appWord.Selection.TypeText Text:=wert2 appWord.Selection.HomeKey Unit:=wdStory, Extend:=wdExtend appWord.NormalTemplate.AutoTextEntries.Add Name:=wert1, Range:=appWord.Selection.Range Next i appWord.Quit Set wdDoc = Nothing Set appWord = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread