Vba Code für Word wird nur einmal ausgeführt

[trebuh]

Hallo Access-Gemeinde,

ich beschäftige mich gerade damit einen Brief in Word aus Access zu starten. Dies klappt soweit ganz gut.

Interessanterweise ist es jetzt so, daß wenn ich die Ereignisprozedur per Button starte es einmal funktioniert.
D.h. der Brief in Word wird erzeugt. Schließe ich nun das Worddokument und starte in Access die Ereignisprozedur erneut, dann wir nur das Standartdocument in Word geöffnet.

Starte ich Access neu, oder Komprimiere und Repariere das Programm, funktioniert es wieder. (Aber auch wieder nur einmal).

Muss ich in dem Vba-Code noch irgendwas ergänzen?

Anbei mal der Code. Es ist nur mal ein Testcode, um zu sehen, ob es funktioniert. Später wird das Accesformular weiter ausgebaut.

Vielen Dank schon mal im vorraus.

Gruß trebuh

Acces Vba-Code:

Private Sub Befehl0_Click()

On Error Resume Next
Dim Word As Object


Set Word = CreateObject("Word.Application") 'Variable initialieren

    If Word Is Nothing Then
        MsgBox "Es konnte keine Verbindung zu Word hergestellt werden!", 16, "Problem"
        Exit Sub
    End If
With Word
    .Visible = True     'Word sichtbar machen
    .Documents.Add      'Neue Worddatei erstellen'
   
 
    If .ActiveWindow.View.SplitSpecial <> wdPaneNone Then .acticewindow.Panes(2).Close
   
    If .ActiveWindow.View.Type = wdNormalView Or .ActiveWindow.View.Type = _
        wdOutlineView Or _
   .ActiveWindow.ActivePane.View.Type = wdMasterView Then .ActiveWindow.ActivePane.View.Type = _
   wdPageView
       
'**********************************************************
'Seitenlayout festlegen

With ActiveDocument.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientPortrait
        .TopMargin = CentimetersToPoints(5.5)       'Rand oben
        .BottomMargin = CentimetersToPoints(2.2)      'Rand unten
        .LeftMargin = CentimetersToPoints(2)        'Rand links
        .RightMargin = CentimetersToPoints(1)       'Rand rechts
        .Gutter = CentimetersToPoints(0)            'Bundsteg
        .HeaderDistance = CentimetersToPoints(1.25) 'Kopfzeile
        .FooterDistance = CentimetersToPoints(1.25) 'Fußzeile
        .PageWidth = CentimetersToPoints(21)        'Seitengröße (Breite)
        .PageHeight = CentimetersToPoints(29.7)     'Seitengröße (Höhe)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .BookFoldPrinting = False
        .BookFoldRevPrinting = False
        .BookFoldPrintingSheets = 1
        .GutterPos = wdGutterPosLeft
    End With


'**********************************************************
'Schriftart und Schriftgröße definieren
With .Selection.Font
        .Name = "Arial"
        .Size = 11
End With



Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
    Selection.TypeText Text:="Schwärzenbach, den " & Me.txt_akt_Datum.Value
    Selection.TypeParagraph
    Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.Font.Bold = wdToggle
    Selection.TypeText Text:="Betreff:"
    Selection.Font.Bold = wdToggle
    Selection.TypeText Text:=" Test Test Test"
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeText Text:="Sehr geehrte Damen und Herren,"
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeText Text:="Mit freundlichem Gruße"
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeText Text:="Max Mustermann"

AppActivate "Word"
End With

End Sub

[MaggieMay]

Hallo,

Interessanterweise ist es jetzt so, daß wenn ich die Ereignisprozedur per Button starte es einmal funktioniert.

das ist typisches Verhalten im Umgang mit Automatisierung anderer Anwendungen aus Access heraus, wenn dies nicht "sauber" codiert wird.
Du kannst nicht unmittelbar auf Word-Objekte zugreifen, sondern musst stets das zu diesem Zweck initiierte Word-Objekt verwenden.
Also nicht so:

Code [Auswählen] Erweitern

With ActiveDocument.PageSetupsondern so:

Code [Auswählen] Erweitern

With .ActiveDocument.PageSetup
Weitere Fälle dieser Art darfst du selber finden.  ;-)

PS:
Wo du vielleicht nicht so leicht von allein drauf kommst ist die Word-Funktion "CentimetersToPoints".

[trebuh]

Hallo MaggieMay,

zuerst vielen Dank für Deine Antwort.
Nun bin ich einen Schritt weiter. Immerhin wird der Text jetzt immer angezeigt.

Nur das mit dem Seitenränder einrichten klappt noch nicht.
Da passiert jetzt gar nichts mehr (Word Standarteinstellungen) .

Scheinbar hast Du mit Deinem Hinweis die richtige Nase gehabt.
Habe jetzt mal einiges rumprobiert. Leider kein Erfolg!
Und im Internet gibt es zu dem Thema Access mit Word fast so gut wie nichts. (Zumindest was mein Fall betrifft).
In den Handbüchern (Handbucher Access und Access VBA) ist diese Angelegenheit auch etwas dürftig.

Wie muss ich es Programmieren, damit es "sauber" codiert ist?
Kannst Du mir ein Handbuch empfehlen, welches den Umgang mit Automatisierung anderer Anwendungen aus Access heraus ausführlich beschreibt?

Gruß trebuh

[MaggieMay]

Nur das mit dem Seitenränder einrichten klappt noch nicht.

Welchen Programmteil meinst du damit?

Habe jetzt mal einiges rumprobiert. Leider kein Erfolg!

Vielleicht solltest du den Code deines letzten Versuchs zeigen, damit man das untersuchen kann.

Kannst Du mir ein Handbuch empfehlen

Leider nein, ich habe mir das alles auch nur per Try & Error bzw. Selbststudium angeeignet.

[Frank77]

Hallo!
Ich hate mir das mal so zusammen gebastelt vieleicht hilft es dir weiter
du musst aber das ResetWordVorlage nach deinen bedürfnissen anpassen wenn die exe Aktivbleibt dann läuft das modul bei mir ohne probleme ca. 1000 mal in einen  ordner zum speichern, zum drucker und per email weg
daher ist der aufruf sub nur ein auszug

gruß Frank

In mdl_Word_Global

<sup>Option Compare Database
Option Explicit
Private wordObj As Word.Application
Private wordObjVorlage As Object

Public Property Get CreateWord() As Word.Application
    On Error Resume Next
    Set wordObj = CreateObject("Word.Application")
    If Err <> 0 Or wordObj Is Nothing Then
        Err = 0
        Set wordObj = CreateObject("Word.Application")
        If Err <> 0 Or wordObj Is Nothing Then
            Beep
            MsgBox "Verbindung zu Word kann nicht aufgebaut werden. " & _
                   Err.Description, vbOKOnly + vbCritical, "Problem !"
            If Not wordObj Is Nothing Then Set wordObj = Nothing
            Exit Property
        End If
    End If
    Set CreateWord = wordObj
End Property

Public Function Word_Mit_Vorlage(Vorlage As String, Show As Boolean) As Object
    On Error GoTo Err_ErrHandler
    ' Wenn Instanz geöffnet wieder verwenden
    If Not wordObj Is Nothing Then
        Set wordObjVorlage = wordObj.Documents.Add(Template:=Vorlage)
        ' Wenn Instanz nicht vorhanden dann erstellen
    End If
    If wordObj Is Nothing Then
        Set wordObj = CreateWord
        wordObj.Visible = Show
        Set wordObjVorlage = wordObj.Documents.Add(Template:=Vorlage)
    End If
    Set Word_Mit_Vorlage = wordObjVorlage
Exit_ErrHandler:
    Exit Function
Err_ErrHandler:
    If Err <> 0 Then
        MsgBox "Vorlage konnte nicht geladen werden. " & _
               Err.Description, vbOKOnly + vbCritical, "Problem !"
    End If
    Call ResetWordVorlage
    Resume Exit_ErrHandler:
End Function

Public Sub SetBookmark(wdDok As Object, strBookmark As String, _
                       varWert As Variant)
    If Not wordObj Is Nothing Then
        If wdDok.Bookmarks.Exists(strBookmark) Then
            With wdDok.Bookmarks(strBookmark).Range
                If Trim(Nz(varWert, "")) <> "" Then
                    .Text = varWert
                Else
                    .Delete
                End If
            End With
        End If
    End If
End Sub

Public Function ResetWordVorlage()
    On Error Resume Next
    'wordObj.Quit  ' killt die Word.exe
    If Not wordObj Is Nothing Then Set wordObj = Nothing
    If Not wordObjVorlage Is Nothing Then Set wordObjVorlage = Nothing
End Function</sup>

Aufruf in etwar so und es schreibt da in ein e vorlage die ein steuerelement enthält

<sub>Private Sub Word()
    Dim wordDoc As Object
    On Error GoTo Err_ErrHandler
    Set wordDoc = Word_Mit_Vorlage(strVorlage, True)
    With wordDoc
        SetBookmark wordDoc, "Steuerelementnameinword", Me!Wert

        If Me!RahmenDrucken.Value = 1 Then    ' Drucken
            .SaveAs strNewName
            .PrintOut
            .Close
        End If
        If Me!RahmenDrucken.Value = 2 Then    ' Erstellen
            .SaveAs strNewName
            .Close
        End If
    End With
Exit_ErrHandler:
    If Not wordDoc Is Nothing Then Set wordDoc = Nothing
    Call ResetWordVorlage
    Exit Sub
Err_ErrHandler:
    Select Case Err.Number
        case ??
        Resume Exit_ErrHandler
    End Select
End Sub</sub>

als buch kann ich das empfehlen
http://www.minhorst.com/index.php/home-73.html

[trebuh]

Hallo MaggieMay und Frank77,

@ MaggieMay

Das Problem besteht jetzt noch darin, dass das mit dem "Seitenränder einrichten" (Seitenlayout festlegen) in Word 2010 nur beim ersten aufruf klappt. Danach wird, wie bereits erwähnt, das Standartdokument geöffnet und der Text eingefügt.
anbei nochmal der Code.

Private Sub cmd_Word_Vers_2_Click()
On Error Resume Next
Dim Word As Object


Set Word = CreateObject("Word.Application") 'Variable initialieren

    If Word Is Nothing Then
        MsgBox "Es konnte keine Verbindung zu Word hergestellt werden!", 16, "Problem"
        Exit Sub
    End If
With Word
    .Visible = True     'Word sichtbar machen
    .Documents.Add      'Neue Worddatei erstellen'
   

   
    If .ActiveWindow.View.SplitSpecial <> wdPaneNone Then .acticewindow.Panes(2).Close
   
    If .ActiveWindow.View.Type = wdNormalView Or .ActiveWindow.View.Type = _
        wdOutlineView Or _
   .ActiveWindow.ActivePane.View.Type = wdMasterView Then .ActiveWindow.ActivePane.View.Type = _
   wdPageView
         

'**********************************************************
'Seitenlayout festlegen

With .ActiveDocument.PageSetup '
        '.LineNumbering.Active = False
        '.Orientation = wdOrientPortrait
        .TopMargin = CentimetersToPoints(5.5)       'Rand oben
        .BottomMargin = CentimetersToPoints(2.2)    'Rand unten
        .LeftMargin = CentimetersToPoints(2)        'Rand links
        .RightMargin = CentimetersToPoints(1)       'Rand rechts
        .Gutter = CentimetersToPoints(0)            'Bundsteg
        .HeaderDistance = CentimetersToPoints(1.25) 'Kopfzeile
        .FooterDistance = CentimetersToPoints(1.25) 'Fußzeile
        .PageWidth = CentimetersToPoints(21)        'Seitengröße (Breite)
        .PageHeight = CentimetersToPoints(29.7)     'Seitengröße (Höhe)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .BookFoldPrinting = False
        .BookFoldRevPrinting = False
        .BookFoldPrintingSheets = 1
        .GutterPos = wdGutterPosLeft
    End With





'**********************************************************
'Schriftart und Schriftgröße definieren
With .Selection.Font
        .Name = "Arial"
        .Size = 11
End With

'**********************************************************
'In den Textteil wechseln und Text eintragen

.Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
    .Selection.TypeText Text:="Musterort, den " & Me.txt_akt_Datum.Value
    .Selection.TypeParagraph
    .Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.Font.Bold = wdToggle
    .Selection.TypeText Text:="Betreff:"
    .Selection.Font.Bold = wdToggle
    .Selection.TypeText Text:=" Test Test Test"
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeText Text:="Sehr geehrte Damen und Herren,"
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeText Text:="Mit freundlichem Gruße"
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeText Text:="Max Mustermann"

AppActivate "Word"
End With

Was hast Du mit:

PS:
Wo du vielleicht nicht so leicht von allein drauf kommst ist die Word-Funktion "CentimetersToPoints".

gemeint?

Ich schätze, das es nur wieder eine Kleinigkeit (mit großer Wirkung) sein kann


@ Frank77

Werde mich mit Deinem Code mal auseinandersetzen.
Danke übrigens für den Buchtipp! So was habe ich schon seit längerem gesucht (Vorausgesetzt es entspricht dem was es verspricht).
Habe es mir schon bestellt.

Gruß
trebuh

[Frank77]

Hallo!

hab es als beispiel angehängt , ist aber noch nicht perfect was die übergabe der objecte angeht des kann noch verbessert werden

Gruß frank

[daolix]

Was hast Du mit:

PS:
Wo du vielleicht nicht so leicht von allein drauf kommst ist die Word-Funktion "CentimetersToPoints".

gemeint?

Ich schätze, das es nur wieder eine Kleinigkeit (mit großer Wirkung) sein kann

Da diese Funktion sich von Word.Application oder Word.Global ableitet musst du beim Aufruf auch die entsprechende Referenz voranstellen. in deinem Fall probier mal:
Word.CentimetersToPoints

[trebuh]

Hallo Frank77 und daolix.

@daolix
Danke für den Hinweis. Jetzt funktioniert es. Da wäre ich zuletzt drauf gekommen. Was ich jetzt schon alles ausprobiert habe. Interessant, das zu dem Thema nix im Internet zu finden ist.

@frank77
Merci für den Anhang! Das mit dem Seitenrand einstellen klappt tadellos. Nun habe ich jetzt aber eine Frage:
So wie ich feststellen musste, scheint der Code wieder etwas anders geschrieben zu sein (Ereignissprozedur im Formular1).
Wenn ich jetzt den Code für eine andere Schrift und den Text einfüge, bekomme ich Fehlermeldungen. Füge ich den Makrocode von Word ein, bekomme ich auch Fehlermeldungen. Was gilt es denn jetzt zu beachten? Habe mal verschiedene Varianten mit der With-Anweisung ausprobiert, Aber leider auch ohne Erfolg.
Da bin ich doch noch ein große Access-Laie

Hast Du mir da nochmal einen Tipp?

Gruß
trebuh

[MaggieMay]

...oder eben einfach nur den Punkt voransetzen, da sich der ganze Code ja im "With Word"-Block befindet.

Wenn ich jetzt den Code für eine andere Schrift und den Text einfüge, bekomme ich Fehlermeldungen.

Du musst schon den Code zeigen, damit man etwas dazu sagen kann.

BTW:
Liebe Leute, stellt doch bitte eure Code-Auszüge in Code-Tags ein.

[Stapi]

Hallo trebuh
Wenn der Code einmal durch Access aufgerufen durchläuft und alles so ist wie du es haben willst, könnte es wohl daran liegen das du Variabel oder Objekte im Anfag deines Code aufrust aber sie am Ende nicht wieder zerstörst. Heist im Klartext so Lange deine Anwendung Access geöffnet ist bleiben die Objekte Variabel gefüllt. 
Als Beispiel aus deinem Code:

Set Word = CreateObject("Word.Application") 'Variable initialieren

Wo wird sie am Ende deines Code mit Set Word = Nothing wieder zurück gesetzt?
Ich habe es nicht gefunden, auch nicht mit Brille

[trebuh]

Hallo Stapi und Hallo MaggieMay.

Zuerst @ Stapi, (denn da ist die Antwort Kürzer )
Da kannst Du lange suchen , denn das habe ich gar nicht berücksichtigt. Und in dem Beispiel aus meienem Access 2010 Handbuch ist das auch nicht drin. (Das ist ja allerhand!)
Ich habe mich jedefalls schon gewundert, wieso es denn einmal klappt. Normalerweise zickt der Computer bei Schreibfehlern ja gleich rum.
Das mit dem zurücksetzen ist von daher eine logische Erklärung. Danke für den Tip.

@ MaggieMay

Sorry, habe gar nicht daran gedacht den Code zu posten, da ich mich geziehlt an Frank77 gewendet habe, weil von ihm der Code ja stammte und der Anhang ja runtergeladen werden kann.
Aber Du hast recht. Schließlich sollen ja auch andere davon profitieren.

Also hier mal der Code:
Dieser ist ja wiederum anders aufgebaut. Das was jetzt bisher an Code klappt, klappt hier wieder nicht.
D.h. Wenn ich jetzt den Teil mit Schriftart und Text  hier anfüge kommen Fehlermeldungen, welche es vorher ja nicht gab
Wie heißt es so schön "Viele Wege führen nach Rom".
Da muss man als Laie erst mal den Durchblick haben.


 
Option Compare Database
Option Explicit
Private Sub cmd_Word_Click()
    Dim Worddatei As Object
Dim i As Integer


    Set Worddatei = Word_Ohne_Vorlage(True)    ' True für Visible
    With Worddatei.PageSetup
        .LineNumbering.Active = False
        '.Orientation = wdOrientPortrait
        .TopMargin = CentimetersToPoints(5.5)       'Rand oben
        .BottomMargin = CentimetersToPoints(2.2)    'Rand unten
        .LeftMargin = CentimetersToPoints(2)        'Rand links
        .RightMargin = CentimetersToPoints(1)       'Rand rechts
        .Gutter = CentimetersToPoints(0)            'Bundsteg
        .HeaderDistance = CentimetersToPoints(1.25)    'Kopfzeile
        .FooterDistance = CentimetersToPoints(1.25)    'Fußzeile
        .PageWidth = CentimetersToPoints(21)        'Seitengröße (Breite)
        .PageHeight = CentimetersToPoints(29.7)     'Seitengröße (Höhe)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .BookFoldPrinting = False
        .BookFoldRevPrinting = False
        .BookFoldPrintingSheets = 1
        .GutterPos = wdGutterPosLeft
    End With

    Call ResetWord
End Sub

Gruß trebuh aus dem leicht verschneiten Südschwarzwald

[MaggieMay]

Das was du da zeigst passt nicht zu dem Ausgangs-Code, so wird das nichts.

Und BITTE poste den Code in CODE-TAGS!

Und wenn es Fehler gibt, nenne bitte die konkrete Fehlermeldung und die betroffene Codezeile.

[trebuh]

Hallo MaggieMay,

kurz noch mal die Sachlage:
Dank eurer Hilfe ist mein Problem behoben.
Der Code sieht so aus:

Code [Auswählen] Erweitern


Private Sub cmd_Word_Vers_2_Click()
On Error Resume Next
Dim Word As Object


Set Word = CreateObject("Word.Application") 'Variable initialieren

    If Word Is Nothing Then
        MsgBox "Es konnte keine Verbindung zu Word hergestellt werden!", 16, "Problem"
        Exit Sub
    End If
With Word
    .Visible = True     'Word sichtbar machen
    .Documents.Add      'Neue Worddatei erstellen'
   

   
    If .ActiveWindow.View.SplitSpecial <> wdPaneNone Then .acticewindow.Panes(2).Close
   
    If .ActiveWindow.View.Type = wdNormalView Or .ActiveWindow.View.Type = _
        wdOutlineView Or _
   .ActiveWindow.ActivePane.View.Type = wdMasterView Then .ActiveWindow.ActivePane.View.Type = _
   wdPageView
         

'**********************************************************
'Seitenlayout festlegen
   With .ActiveDocument.Styles(wdStyleNormal).Font
        If .NameFarEast = .NameAscii Then
            .NameAscii = ""
        End If
        .NameFarEast = ""
    End With


With .ActiveDocument.PageSetup '
        .LineNumbering.Active = False
        .Orientation = wdOrientPortrait
        .TopMargin = Word.CentimetersToPoints(5.5)       'Rand oben
        .BottomMargin = Word.CentimetersToPoints(2.2)    'Rand unten
        .LeftMargin = Word.CentimetersToPoints(2)        'Rand links
        .RightMargin = Word.CentimetersToPoints(1)       'Rand rechts
        .Gutter = Word.CentimetersToPoints(0)            'Bundsteg
        .HeaderDistance = Word.CentimetersToPoints(1.25) 'Kopfzeile
        .FooterDistance = CentimetersToPoints(1.25) 'Fußzeile
        .PageWidth = Word.CentimetersToPoints(21)        'Seitengröße (Breite)
        .PageHeight = Word.CentimetersToPoints(29.7)     'Seitengröße (Höhe)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .BookFoldPrinting = False
        .BookFoldRevPrinting = False
        Word.BookFoldPrintingSheets = 1
        Word.GutterPos = wdGutterPosLeft
    End With

'**********************************************************
'Schriftart und Schriftgröße definieren
    With .Selection.Font
            .Name = "Arial"
            .Size = 12
    End With

'**********************************************************
'Schrift einfügen

    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
    .Selection.TypeText Text:="Schwärzenbach, den " & Me.txt_akt_Datum.Value
    .Selection.TypeParagraph
    .Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.Font.Bold = wdToggle
    .Selection.TypeText Text:="Betreff: "
    .Selection.Font.Bold = wdToggle
    .Selection.TypeText Text:=Me.txt_Betreffeingabe.Value
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeText Text:="Sehr geehrte Damen und Herren,"
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeText Text:="Mit freundlichem Gruße"
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeText Text:="Max Mustermann"

End With

AppActivate "Word"
Set Word = Nothing
End Sub


Frank77 hat mir mit seiner Access-Variante Modul und Formular eine weiter Möglichkeit gezeigt. Hier fehlt jedoch noch die Schriftwahl und das Texteinfügen.
Modul-Code:

Code [Auswählen] Erweitern


Option Compare Database
Option Explicit
Private wordObj As Word.Application
Private wordObjVorlage As Object
Private wordObjDoc As Object
Public Property Get CreateWord() As Word.Application
    On Error Resume Next
    Set wordObj = CreateObject("Word.Application")
    If Err <> 0 Or wordObj Is Nothing Then
        Err = 0
        Set wordObj = CreateObject("Word.Application")
        If Err <> 0 Or wordObj Is Nothing Then
            Beep
            MsgBox "Verbindung zu Word kann nicht aufgebaut werden. " & _
                   Err.Description, vbOKOnly + vbCritical, "Problem !"
            If Not wordObj Is Nothing Then Set wordObj = Nothing
            Exit Property
        End If
    End If
    Set CreateWord = wordObj
End Property
Public Function Word_Ohne_Vorlage(Show As Boolean) As Object
    On Error GoTo Err_ErrHandler
    If Not wordObj Is Nothing Then
        Set wordObjDoc = wordObj.Documents.Add
    End If
    If wordObj Is Nothing Then
        Set wordObj = CreateWord
        wordObj.Visible = Show
        Set wordObjDoc = wordObj.Documents.Add
    End If
    Set Word_Ohne_Vorlage = wordObjDoc
Exit_ErrHandler:
    Exit Function
Err_ErrHandler:
    If Err <> 0 Then
        MsgBox "Word konnte nicht geladen werden. " & _
               Err.Description, vbOKOnly + vbCritical, "Problem !"
    End If
    'Call ResetWord
    Resume Exit_ErrHandler:
End Function
Public Function Word_Mit_Vorlage(Vorlage As String, Show As Boolean) As Object
    On Error GoTo Err_ErrHandler
    If Not wordObj Is Nothing Then
        Set wordObjVorlage = wordObj.Documents.Add(Template:=Vorlage)
    End If
    If wordObj Is Nothing Then
        Set wordObj = CreateWord
        wordObj.Visible = Show
        Set wordObjVorlage = wordObj.Documents.Add(Template:=Vorlage)
    End If
    Set Word_Mit_Vorlage = wordObjVorlage
Exit_ErrHandler:
    Exit Function
Err_ErrHandler:
    If Err <> 0 Then
        MsgBox "Vorlage konnte nicht geladen werden. " & _
               Err.Description, vbOKOnly + vbCritical, "Problem !"
    End If
    Call ResetWord
    Resume Exit_ErrHandler:
End Function
Public Sub ResetWord()  ' mit.exe zu beenden
    On Error Resume Next
    wordObj.Quit
    If Not wordObj Is Nothing Then
        Set wordObj = Nothing
    End If
    If Not wordObjVorlage Is Nothing Then
        Set wordObjVorlage = Nothing
    End If
End Sub
Public Sub SetBookmark(wdDok As Object, strBookmark As String, _
                       varWert As Variant)
    If Not wordObj Is Nothing Then
        If wdDok.Bookmarks.Exists(strBookmark) Then
            With wdDok.Bookmarks(strBookmark).Range
                If Trim$(Nz(varWert, "")) <> "" Then
                    .Text = varWert
                Else
                    .Delete
                End If
            End With
        End If
    End If
End Sub
Public Function ResetWordVorlage() 'ohne die .exe zu beenden
    On Error Resume Next
    If Not wordObj Is Nothing Then
        Set wordObj = Nothing
    End If
    If Not wordObjVorlage Is Nothing Then
        Set wordObjVorlage = Nothing
    End If
End Function


Formular-Ereignisprozedur-Code:

Code [Auswählen] Erweitern


Option Compare Database
Option Explicit
Private Sub cmd_Word_Click()
    Dim Worddatei As Object

    Set Worddatei = Word_Ohne_Vorlage(True)    ' True für Visible
    With Worddatei.PageSetup
        .LineNumbering.Active = False
        '.Orientation = wdOrientPortrait
        .TopMargin = CentimetersToPoints(5.5)       'Rand oben
        .BottomMargin = CentimetersToPoints(2.2)    'Rand unten
        .LeftMargin = CentimetersToPoints(2)        'Rand links
        .RightMargin = CentimetersToPoints(1)       'Rand rechts
        .Gutter = CentimetersToPoints(0)            'Bundsteg
        .HeaderDistance = CentimetersToPoints(1.25)    'Kopfzeile
        .FooterDistance = CentimetersToPoints(1.25)    'Fußzeile
        .PageWidth = CentimetersToPoints(21)        'Seitengröße (Breite)
        .PageHeight = CentimetersToPoints(29.7)     'Seitengröße (Höhe)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .BookFoldPrinting = False
        .BookFoldRevPrinting = False
        .BookFoldPrintingSheets = 1
        .GutterPos = wdGutterPosLeft

    End With
   Call ResetWord

End Sub


Nun wollte ich den fehlenden Teil (welcher in der 1. Variante ja funktioniert)

Code [Auswählen] Erweitern


'**********************************************************
'Schriftart und Schriftgröße definieren
    With .Selection.Font
            .Name = "Arial"
            .Size = 12
    End With

'**********************************************************
'Schrift einfügen

    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
    .Selection.TypeText Text:="Schwärzenbach, den " & Me.txt_akt_Datum.Value
    .Selection.TypeParagraph
    .Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.Font.Bold = wdToggle
    .Selection.TypeText Text:="Betreff: "
    .Selection.Font.Bold = wdToggle
    .Selection.TypeText Text:=Me.txt_Betreffeingabe.Value
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeText Text:="Sehr geehrte Damen und Herren,"
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeText Text:="Mit freundlichem Gruße"
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.TypeText Text:="Max Mustermann"
in die Ereignisprozedur einfügen.
Leider mit keinem Erfolg.
Daher meine Frage:
Wie muss der Code aussehen, damit es funktioniert?

gruß und schönen Sonntag
trebuh

[Frank77]

Hallo!
Mir Gings am Anfang auch nicht anders und wenn nicht weist wo du suchen sollst da drehst dich im kreis

wenn du _{TypeParagraph} in Vba Editor markierst und F1 drückst erhält du Infos dazu

Das wird die weiterhelfen

Ich hab dir mal ein Beispiel angehängt das mit einer Vorlage arbeitet und es mal so dargestellt (ich bin auch kein Profi) das du es vielleicht nachvollziehen kannst
Wenn du _{Call ResetWord} aufrufst da ist feierabend

Ich nehme mal an das du bei   _{.Selection.TypeParagraph} den fehler bekommst verweis auf ein nicht mehr vorhandenes object

Ich würd sagen arbeite mit einer Vorlage die ist doch eher immer gleich in meiner Vorlage ein Brief im DIN Format 

In der Vorlage sind graue Felder die haben einen Namen unter Eigenschaften und die füllst hier z.B. Firma aus einem Recordset also wenn es sein muss 100 am stück

_{SetBookmark wordDoc, "Firma", rstWord.Fields("Test_Firma")}

Wenn es nachvollziehen kannst wie die Sache da abläuft versuch mal den Text Korpus zu füllen

Das _{mdl_Pfad} Gibt an wo die Vorlage ist und wo das Word Doc gespeichert wird

Code [Auswählen] Erweitern

Public Function akt_Verz_vorlage() As String
    akt_Verz_vorlage = CurrentProject.Path & "\Vorlage DIN 5008.docx"
End Function
Public Function akt_Verz_vorlage_Save() As String
    akt_Verz_vorlage_Save = Environ("UserProfile") & "\Desktop\"
End Function

Hier der Aufruf

    Private Sub cmd_Word_Click()
    Dim wordDoc As Object
    Dim rstWord As DAO.Recordset
    Dim ingAnzahl As Long
    Dim Msg As String
    Dim strSavename As String
    On Error GoTo Err_ErrHandler
    Set rstWord = CurrentDb.OpenRecordset("tbl_Test", dbOpenSnapshot)
    With rstWord
        If Not .EOF Then
            .MoveLast
            ingAnzahl = .RecordCount
            .MoveFirst
            Msg = "         Es werden" & "  " & ingAnzahl & "  " & "Dokumente erstellt," & vbCr & _
                  "Sie können den Vorgang an dieser Stelle noch beenden"
            If MsgBox(Msg, vbInformation Or vbOKCancel, "Achtung !") = vbOK Then
                ' OK
                DoCmd.Hourglass True
                Do Until .EOF
                    strSavename = akt_Verz_vorlage_Save & .Fields("Test_BriefID") & " " & Format$(Date, "dd.mm.yyyy")
                    Set wordDoc = Word_Mit_Vorlage(akt_Verz_vorlage, True)
                    With wordDoc
                        SetBookmark wordDoc, "Firma", rstWord.Fields("Test_Firma")
                        SetBookmark wordDoc, "PersAnrede", rstWord.Fields("Test_PersAnrede")
                        SetBookmark wordDoc, "Name", rstWord.Fields("Test_Name")
                        SetBookmark wordDoc, "Adresse", rstWord.Fields("Test_Adresse")
                        SetBookmark wordDoc, "Ort", rstWord.Fields("Test_Ort")
                        SetBookmark wordDoc, "BriefID", rstWord.Fields("Test_BriefID")
                        SetBookmark wordDoc, "Betreff", rstWord.Fields("Test_Betreff")
                        SetBookmark wordDoc, "Anrede", rstWord.Fields("Test_Anrede")
                        SetBookmark wordDoc, "Datum", Format$(Date, "dd.mm.yyyy")
                        Select Case Me!RahmenDrucken
                        Case 1    ' Drucken
                            .PrintOut
                            .Close wdDoNotSaveChanges
                        Case 2    'Speichern
                            If Dir$(strSavename & ".docx") <> "" Then
                                Msg = "Die Datei Existiert bereits !" & vbCr & "" & vbCr & "Möchten sie sie ersetzen ?"
                                If MsgBox(Msg, vbInformation Or vbYesNo Or vbDefaultButton2, "vorhanden !") = vbYes Then
                                    ' Ja
                                    .SaveAs strSavename & ".docx"
                                    .Close
                                Else
                                    ' Nein
                                    .Close wdDoNotSaveChanges
                                End If
                            Else
                                .SaveAs strSavename & ".docx"
                                .Close
                            End If
                        Case 3    'Pdf
                            .ExportAsFixedFormat OutputFileName:=strSavename & ".pdf" _
                                               , ExportFormat:=wdExportFormatPDF _
                                               , OpenAfterExport:=False _
                                               , OptimizeFor:=wdExportOptimizeForPrint _
                                               , Range:=wdExportAllDocument, From:=1, To:=1 _
                                               , Item:=wdExportDocumentContent _
                                               , IncludeDocProps:=True, KeepIRM:=True _
                                               , CreateBookmarks:=wdExportCreateNoBookmarks _
                                               , DocStructureTags:=True _
                                               , BitmapMissingFonts:=True, UseISO19005_1:=False
                        End Select
                        Set wordDoc = Nothing
                    End With
                    .MoveNext
                Loop
            Else    ' Abbrechen
                GoTo Exit_ErrHandler
            End If
        End If
    End With
Exit_ErrHandler:
    If Not wordDoc Is Nothing Then Set wordDoc = Nothing
    If Not rstWord Is Nothing Then rstWord.Close: Set rstWord = Nothing
    Call ResetWord
    DoCmd.Hourglass False
    Exit Sub
Err_ErrHandler:
    Select Case Err.Number
    Case 3159    'not a valid bookmark
        '???????????
        Resume Exit_ErrHandler
    Case 91    ' Recordset fehler
        '??????
        Resume Exit_ErrHandler
    Case Else
        Resume Exit_ErrHandler
    End Select
End Sub


Gruß Frank