Blog Schröder

Sammlung von Codeschnipseln zu Programmierproblemen.
Daten aus fremden Quellen unterliegen deren Rechten.
Siehe auch: Disclaimer auf www.computer-schroeder.de

Mittwoch, 1. April 2009

Aus VBA Word-Dokument erzeugen und darin Textmarken überschreiben


filesys:       Filesystemobjekt (vorher angelegt)
wdApp:         Word.Application-Objekt (vorher angelegt)
TEMPLATENAME:  Dateiname (inkl. Pfad) einer .DOT-Datei
STRINGCONTROL: Textbox o.a., enthält Name der Textmarke

...
'
existiert die Dokumentvorlage? 
    Dim bEx As Boolean
    On Error GoTo Er
    If Not filesys.FileExists(TEMPLATENAME) Then
        MsgBox "Die Dokumentvorlage " &
TEMPLATENAME & " wurde nicht gefunden."
        GoTo Ex
    End If
    On Error Resume Next
'prüfen, ob das Word-Objekt (noch) existiert
    Err.Clear
    bEx = wdApp.Documents.Count = 0
    If Err.Number = 462 Or Err.Number = 91 Then
        Set wdApp = Nothing
        Set wdApp = New Word.Application
        Resume
    ElseIf Err.Number > 0 Then
        GoTo Er
    End If
'erstelle das neue Dokument   
    On Error GoTo Er
    wdApp.Documents.Add
TEMPLATENAME, False, wdNewBlankDocument, True

'ersetze Textmarke durch einen Text   
    With wdApp.Documents(wdApp.Documents.Count)  'das zuletzt angelegte Dokument
        On Error Resume Next
        .Visible = False
        'Beispiel: Eine Textmarke namens Firma wird überschrieben
        Dim bmString As String: bmString = STRINGCONTROL & ""
        bEx = .Bookmarks.Exists("Firma")
        If bmString & "" > "" And bEx Then
            wdApp.Selection.Goto what:=wdGoToBookmark, Name:="Firma"
            wdApp.Selection.TypeText Text:=bmString
        End If
...
    End With
'Zeige das Dokument an   
    wdApp.Selection.Goto wdGoToLine, wdGoToFirst
    wdApp.Visible = True
    wdApp.Activate
...
'Fehlerbehandlung
Ex: Exit Function
Er: MsgBox "Fehler " & Err.Number & " in NAMEOFPROCEDURE" _
    & vbCrLf & Err.Description
    Resume Ex
End...



nicht vergessen:

SET filesys=nothing
Set wdApp=Nothing


Labels: , , , , , ,