Textmarke in Word von Excel aus füllen

[Steffen]

Hallo Leute,

ich habe mir folgendes Makro zusammengewurstet, aber leider klappt dieses
gar nicht!

Ich möchte aus einer bestimmten Excel Zelle eine Textmarke in Word füllen,
ein Word Makro starten und dann das Word dokument drucken

Mein Code:

Option Explicit

Sub sWordAdr()
' Inhalte der Zellen A1 und A2 der 1. EXCEL- Tabelle in ein Word- Dokument
übertragen

Dim appWord As Object

Set appWord = GetObject(, "Word.Application")
appWord.Visible = True
appWord.Documents.Open "C:\Testen\Test.doc"
'Set AppWord = Nothing

Dim VorName As String: VorName = Worksheets(1).Range("A1").Value
Dim NachName As String: NachName = Worksheets(1).Range("A2").Value

With appWord.ActiveDocument ' *** ab jetzt "Word- VBA"
.Visible = True
.Activate
.FormFields("Test1").Result = VorName
End With

AppWord.PrintOut
'AppWord.ActiveDocument.Close SaveChanges:=False
'AppWord.Quit

End With ' *** ab jetzt wieder EXCEL- VBA

'Set AppWord = Nothing

End Sub

Vielleicht habt Ihr ne Idee, ich weis echt nicht weiter

Danke schonmal

Steffen

[Dr. Eckehard Pfeifer]

Hallo, und was funktioniert nun nicht?

--
MfG Eckehard Pfeifer

www.dr-e-pfeifer.de

[Dr. Eckehard Pfeifer]

habs grade noch mal gelesen. Wenns eine Textmarke sein soll, dann ist es
nicht FormFields, sondern Bookmarks.

[Philipp von Wartburg]

Hallo Steffen

Die Antwort von Eckehard ist korrekt: Textmarken werden
über Bookmarks angesprochen. Da ich mich auch mal mit der
Bookmarks-Auflistung auseinandersetzen musste (sie hat ihre
speziellen Eigenheiten - oder dann hab' ihre Benutzung nicht
ganz kapiert), hier ein Codebeispiel meiner Lösung:

Sub TextmarkenAnsteuern()
'Deklaration der Objekt-Variablen
Dim appWord As Object
Dim wrdDocument as Object

'Word-Instanz übernehmen oder starten
On Error Resume Next

Set appWord = GetObject(, "Word.Application")

If Err = 429 Then
Err.Clear
Set appWord = CreateObject("Word.Application")
If Err > 0 Then
MsgBox "Fehler beim Starten von Word!"
Exit Sub
End If
End If
Err.Clear

'Dokument öffnen
Set wrdDocument = appWord.Documents.Open("C:\Testen\Test.doc")
If Err = 1004 Then
MsgBox "Dokument 'Test.doc' nicht vorhanden!"
appWord.Quit
Set appWord = Nothing
Exit Sub
End If
On Error Goto 0
appWord.Visible = True

'Textmarken ansprechen und Text eintragen
wrdDocument.Bookmarks("Textmarke1").Select
appWord.Selection.MoveLeft , , True
appWord.Selection.TypeText "Mustertext Eins"

wrdDocument.Bookmarks("Textmarke2").Select
appWord.Selection.MoveLeft , , True
appWord.Selection.TypeText "Mustertext Zwei"

'Weitere Programmbefehle...
End Sub

Das Problem bei Bookmark ist das Fehlen einer
Eigenschaft, die den Text einer Textmarke zurückgibt.
Als Umgehungslösung habe ich daher Select verwendet,
damit der Text markiert und dann über das Selection-
Objekt erreichbar wird. Das zweite Problem ist die
nicht vollständige Markierung des Textes. Bei meinem
Dokument (Word 97) wird immer das erste Zeichen
nicht markiert. Daher die MoveLeft-Anweisung zum
Erweitern der Selektion. Mit TypeText wird wie gewohnt
ein Text in das Dokument eingefügt.

HTH
Gruss
Philipp

Steffen schrieb in Nachricht ...

[Dr. Eckehard Pfeifer]

Hallo, Philipp, eine kleine Ergaenzung. Der Text von Textmarken laesst sich
anspringen:

ThisDocument.Bookmarks("bmTest").Range.Text = "..."

Nachteil: Die Textmarke ist anschliessend als solche verschwunden. Will man
das Umgehen, so wirkt dein Movebefehl mit anschliessendem Neudefinieren der
Textmarke an gleicher Stelle

ThisDocument.Bookmarks.Add "bmTest",Selection

[Bernhard Fischer]

Hallo,
Wie bekommt man nun statt
....TypeText "Mustertext Zwei"
a) den Wert von z.b. Zelle A1 rein
b) oder direkt einen Namen "Ergebnis"
Danke Bernhard

"Philipp von Wartburg" <philipp.vo...@bluewin.ch> schrieb im
Newsbeitrag news:3da8c...@news.bluewin.ch...

[Philipp von Wartburg]

Hallo Bernhard

Anstelle "Mustertext Zwei" im Beispiel
appWord.Selection.TypeText "Mustertext Zwei"
kannst Du einen beliebigen Ausdruck verwenden,
der eine Zeichenfolge liefert.

Beispiel Zelle A1:
[...].TypeText ActiveSheet.Range("A1").Value

Beispiel benannte Zelle "Ergebnis":
[...].TypeText ActiveSheet.Range("Ergebnis").Value

Beispiel Benutzerformular-Textbox "txtEingabe":
[...].TypeText frmDialog.txtEingabe.Text

Gruss
Philipp

Bernhard Fischer schrieb in Nachricht ...

[Philipp von Wartburg]

Hallo Eckehard

Den Tipp mit "Range.Text" kannte ich tatsächlich nicht.
Besten Dank.

Gruss
Philipp

Dr. Eckehard Pfeifer schrieb in Nachricht ...

[Bernhard Fischer]

Hi Phillip, danke erst mal!
Meine letze(n) Frage(n) zu diesem Thema:
Es soll Meinpfad\Vorlage.Dot aufgerufen werden und diese zum Ausfüllen
als Meinpfad\TMP.Doc gespeichert werden, auch wenn diese bereits schon
aufgerufen und geöffnet ist.
Wie kann ich in diesem Fall den "Fehler 5153 ... kann nicht unter
gleichem Namen gespeichert werden..." umgehen oder automatisch Save
anstelle Saveas erzeugen?
Soweit bin ich schon, leider funzen die Fehlersituationen nicht -> keine
oder falsche MSG..(Ich hab Office 2000 SR1):

'VORLAGE.DOT öffnen
Set wrdDocument = appWord.Documents.Open("MEINPFAD\MEINEVORLAGE.dot")

If Err = 1004 Then

MsgBox "Dokument 'MEINEVORLAGE' nicht vorhanden!"

appWord.Quit
Set appWord = Nothing
Exit Sub
End If

On Error GoTo 0
appWord.Visible = True

'Als TEM.DOC Zwischenspeichern
wrdDocument.SaveAs "C:\MEINPFAD\TMP.DOC"
If Error = 5153 Then
MsgBox "Dokument Ist bereits geöffnet- vorher schliessen!"

appWord.Quit
Set appWord = Nothing
Exit Sub
End If

On Error GoTo 0

DANKE nochmals für Eure Tipps!
Bernhard

"Philipp von Wartburg" <philipp.vo...@bluewin.ch> schrieb im

Newsbeitrag news:3da9e5f8$1...@news.bluewin.ch...

[Steffen]

mit folgendem Makro:

Sub Karten_drucken()

'Deklaration der Objekt-Variablen
Dim appWord As Object

Dim wrdDocument As Object

'Word-Instanz übernehmen oder starten
On Error Resume Next

Set appWord = GetObject(, "Word.Application")

If Err = 429 Then
Err.Clear
Set appWord = CreateObject("Word.Application")
If Err > 0 Then
MsgBox "Fehler beim Starten von Word!"
Exit Sub
End If
End If
Err.Clear

'Dokument öffnen
Set wrdDocument = appWord.Documents.Open(ActiveWorkbook.Path &
"\Kartendruck_Email.doc") '"C:\Testen\

If Err = 1004 Then

MsgBox "Dokument 'Test.doc' nicht vorhanden!"

appWord.Quit
Set appWord = Nothing
Exit Sub
End If
On Error GoTo 0
appWord.Visible = True

Dim Name1 As String: Name1 = Worksheets("C&M_Antrag").Range("C7").Value
Dim Name2 As String: Name2 = Worksheets("C&M_Antrag").Range("C9").Value
Dim Kundennr As String: Kundennr =
Worksheets("C&M_Antrag").Range("C11").Value
Dim Fhgstnr As String: Fhgstnr = Worksheets("C&M_Antrag").Range("C13").Value
Dim Rabatt As String: Rabatt = Worksheets("C&M_Antrag").Range("A23").Value

wrdDocument.FormFields("Name1").Result = Name1
wrdDocument.FormFields("Name2").Result = Name2
wrdDocument.FormFields("Kundennr").Result = Kundennr
wrdDocument.FormFields("Fhgstnr").Result = Fhgstnr
wrdDocument.FormFields("Rabatt").Result = Rabatt

'Anwendung beenden
Application.Quit
Application.DisplayAlerts = False
ActiveWorkbook.Close savechanges:=False
Application.DisplayAlerts = True

End Sub

Danke nochmals

Steffen

[Ingo]

Hallo zusammen,

ich habe eure Einträge gelesen und sie haben mich ein ganzes Stück weitergebracht. Vielen Dank dafür. Doch nun hänge ich an dem Punkt, dass ich nicht das gesamte Worddokument drucken möchte, sondern nur die aktuelle Seite (mit dem Standarddrucker).

Mein Makro basiert auf dem Quellcode von Philipp (13.02.2002)

Vielen Dank