COM-Schnittstelle MS Word

[Axel]

Sehr oft wird hier im Forum danach gefragt wie kann ich Daten in ein Worddokument einfügen oder wie erstelle ich einen Serienbrief.

Ich möchte, alternativ zu diesem Thread COM-Schnittstelle MS Excel, das gleiche für Word zusammentragen und daraus eine Klasse und/oder einzelne Funktionen in einer Scriptlibrary erstellen.

Ich freue mit schon auf zahlreiche Beiträge. Auch hier bitte für eine bessere Übersicht pro Funktion eine Antwort.

Axel

[Axel]

Hier gleich mal eine Klasse mit einigen Grundfunktionen.

Code

'--- Deklaration von API-Funktionen ---
Declare Function SetActiveWindow Lib "user32" Alias "SetActiveWindow" (Byval Hwnd As Long) As Long
Declare Function SetForegroundWindow Lib "user32" (Byval Hwnd As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (Byval ClassName As String, Byval lpWindowName As Long) As Long

'--- Klasse cWord     Klasse mit Grundfunktionen
Class cWord
	
  objWord As Variant
	
  'Kontruktor - Prozedur
  Sub New        
    Set objWord = Nothing
		
    On Error Resume Next
    Set objWord = GetObject("", "Word.Application")
    If Err = 208 Then  '  Fehler 208 tritt auf wenn Word noch nicht läuft
     Err = 0
     Set objWord = CreateObject("Word.Application")
     objWord.Visible = True  'Word sichtbar machen
    End If  'If Err = 208 Then
  End Sub
	
	
  'Destruktor-Prozedur
  Sub Delete
    Set objWord = Nothing         
  End Sub
	
	
  'Beendet Word
  Sub CloseWord
    objWord.Quit 0
  End Sub
	
	
  'Bringt Word als Vollbild in den Vordergrund
  Sub ActivateWord     
	
    Dim hWnd As Long
	
    objWord.WindowState = 1  ' Application - Fenster auf Vollbild	
    hWnd = FindWindow("OPUSAPP", 0)  'Handle auf Wordfenster
    If hWnd = 0 Then Exit Sub		
    Call SetActiveWindow(hWnd) 
    Call SetForegroundWindow(hWnd)
  End Sub
	
	
  'Neues Dokument auf Basis einer Vorlage erstellen. Name wird als Parameter übergeben.
  Sub CreateNewDoc (strVorlage As String)        
    objWord.Documents.Add Rtrim$(strVorlage), False  
  End Sub
	
	
  'Einfügen eines Textbausteins an einer Textmarke
    Sub InsertAutoTextAtBM(strMarke As String, strTextbaustein As String)
      objWord.ActiveDocument.Bookmarks(strMarke).Select   ' Zu Textmarke springen
      objWord.ActiveDocument.AttachedTemplate.AutoTextEntries(Cstr(strTextbaustein)).Insert(objWord.Selection.Range)
    End Sub
	
	
  'Einfügen eines Textbausteins in Fußzeile
  Sub InsertAutoTextInFooter(strText As String)
    'Geteilte Darstellung aufheben
    If objWord.ActiveWindow.View.SplitSpecial <> wdPageNone Then
      objWord.ActiveWindow.Panes(2).Close
    End If  'If objWord.ActiveWindow.View.SplitSpecial <> wdPageNone Then
		
    'Wenn nicht Seitenlayout angezeigt wird, das umschalten auf Ansicht Seitenlayout
    If objWord.ActiveWindow.ActivePane.View.Type = wdNormalView Or _
      objWord.ActiveWindow.ActivePane.View.Type = wdOutlineView Or _
      objWord.ActiveWindow.ActivePane.View.Type = wdMasterView Then
      objWord.ActiveWindow.ActivePane.View.Type = wdPageView
    End If  'If objWord.ActiveWindow.ActivePane.View.Type = wdNor...
		
  'Anzeigen der Fußzeile
    objWord.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    If objWord.Selection.HeaderFooter.IsHeader = True Then
      objWord.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
    Else
      objWord.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    End If  'If objWord.Selection.HeaderFooter.IsHeader = True Then
		
   'Textbaustein in Fußzeile einfügen
    objWord.ActiveDocument.AttachedTemplate.AutoTextEntries(Cstr(strText)).Insert(objWord.Selection.Range)
		
		
    If objWord.ActiveWindow.View.SplitSpecial = wdPageNone Then
      objWord.ActiveWindow.ActivePane.View.Type = wdNormalView
    Else
      objWord.ActiveWindow.View.Type = wdNormalView
    End If  'If objWord.ActiveWindow.View.SplitSpecial = wdPageNone Then
		
  End Sub
	
	
  'Setzen der Schriftart, derSchriftgröße und verschiedener Attribut
  Sub SetFontAttributes(strFont As String, intSize As Integer, intBold As Integer, intItalic As Integer, intUnderline As Integer)         
    With objWord.Selection.Font
      .Name = Cstr(strFont)  'Schriftart
      .Size = intSize  'Schriftgröße
      .Bold = intBold  'Fett
      .Italic = intItalic  'Kursiv
      .Underline = intUnderline  'Unterstreichen
    End With		
  End Sub
	
	
 'Einfügen von Texten, die als Parameter übergeben werden, in Formularfelder.
  Sub InsertInField(strFeld As String, strText As String)
    objWord.ActiveDocument.FormFields(Cstr(strFeld)).Result = strText
  End Sub
	
	
  'Einfügen eines Textes an einer Textmarke
  Sub InsertAtTM(strMarke As String, strText As String)
    objWord.ActiveDocument.Bookmarks(strMarke).Select   ' Zu Textmarke springen
    objWord.Selection.TypeText strText                                 ' text an Cursorposition einfügen
  End Sub
	
	
  'Einfügen eines Textes an aktuelle Cursorposition
  Sub Insert(strText As String)
    objWord.Selection.TypeText strText                                 ' Text an Cursorposition einfügen
  End Sub
	
	
  'Springen zu einer Textmarke
  Sub GotoTM(strMarke As String)
    objWord.ActiveDocument.Bookmarks(strMarke).Select   ' Zu Textmarke springen          
  End Sub
	
	
  'Einfügen von einem oder mehreren Zeilenumbrüchen
  Sub NewLine(intCount As Integer)
     Dim i As Integer

     For i = 1 To intCount
       objWord.Selection.TypeParagraph                                ' Zeilenschaltung einfügen	
     Next  'For i = 1 To intCount
  End Sub
	
	
  'Ausführen eines Makros 
  Sub RunMacro (strMakro As String)
    'Abfrage ob Dokument geschützt ist. Wenn ja, muß er vorher aufgehoben werden.
    'Es darf kein Passwort vorhanden sein
    If objWord.ActiveDocument.ProtectionType <> wdNoProtection Then
      objWord.ActiveDocument.Unprotect
      objWord.Run strMakro
      'Dokumentenschutz wieder einschalten
      objWord.ActiveDocument.Protect wdAllowOnlyFormFields, True, ""
    Else
      objWord.Run strMakro               
    End If
  End Sub
	
  'Ausführen einens Makros mit Übergabe eines Parameters	
  Sub RunMacroEx (strMakro As String, strParam As String)
    'Abfrage ob Dokument geschützt ist. Wenn ja, muß er vorher aufgehoben werden
    'Es darf kein Passwort vorhanden sein
    If objWord.ActiveDocument.ProtectionType <> wdNoProtection Then
      objWord.ActiveDocument.Unprotect
      Call objWord.Run(strMakro, strParam)
      'Dokumentenschutz wieder einschalten
      objWord.ActiveDocument.Protect wdAllowOnlyFormFields, True, ""
    Else
      Call objWord.Run(strMakro, strParam)
    End If
  End Sub
	
End Class  'Class cWord

Dazu gehört noch eine Library den benötigten Word-Konstanten. Diese muss mit

Use "Word-Konstanten"

im [Options] - Abschnitt der Lib für die Klasse eingebunden werden. Die Lib mit den Konstanten ist im Anhang zu finden.

Eine detaillierte Auflistung der Word-Konstanten ist hier zu finden.


Axel

[ata]

... da kann ich auch noch einiges beitragen...

Toni

[Fedaykin]

Hi zusammen

Wenn es wem hilft helfe ich auch bei dem Teil.

Sonst folgendes:
-Mit Select und Selection arbeiten ist oft nicht so toll (sinnlose rumhüpferei, mit Range arbeiten ist besser)
-Textmarken in Kopf-/Fusszeile ausfüllen ist auch so Sache für sich (Stichwort: StoryRanges)
-Formfields ausfüllen kann auch gemein werden (mehr als bestimmte Anzahl Zeichen und CRLF), gibt aber Trick.

Also meldet euch wenn an meiner Hilfe interessiert.

Gruss
Remo

[koehlerbv]

Natürlich sind wir interessiert!

Danke im Voraus, Remo.

Bernhard

[ata]

@Remo,

Sonst folgendes:
-Mit Select und Selection arbeiten ist oft nicht so toll (sinnlose rumhüpferei, mit Range arbeiten ist besser)
-Textmarken in Kopf-/Fusszeile ausfüllen ist auch so Sache für sich (Stichwort: StoryRanges)
-Formfields ausfüllen kann auch gemein werden (mehr als bestimmte Anzahl Zeichen und CRLF), gibt aber Trick.

... das kann ich so bestätigen - ähnliches gilt ja auch bei EXCEL...

Deine Hilfe ist jederzeit willkommen - dein Trick würde mich interessieren... 

Toni

[Axel]

Also meldet euch wenn an meiner Hilfe interessiert.

Aber selbstverständlich sind wir interessiert. Für Verbesserungsvorschläge und Hinweise auf Stolperfallen sind wir immer dankbar.

Hier ist jede Hilfe willkomen.

Vielen Dank im Voraus an alle die helfen.

Sonst folgendes:
...
-Textmarken in Kopf-/Fusszeile ausfüllen ist auch so Sache für sich (Stichwort: StoryRanges)
-Formfields ausfüllen kann auch gemein werden (mehr als bestimmte Anzahl Zeichen und CRLF), gibt aber Trick.

Textmarken in Kopf-/Fusszeilen kann man doch garnicht nutzen. Mir ist es wenigsten bisher nicht gelungen.
An dem Trick für die FormFields wäre ich auch interessiert. Obwohl ich, bedingt bei Problemen beim Ausdruck, immer weniger Formularfelder in Word verwende.


Axel

[Fedaykin]

Hi zusammen

Habe erst mal folgendes zum anschauen.

'Einfügen eines Textes an einer Textmarke
Sub InsertAtTM(strMarke As String, strText As String)
'   Dim objWord As Application
'   Set objWord = Application
   Dim bmrange As Variant
   With objWord.ActiveDocument
       Set bmrange = .Bookmarks(strMarke).Range
       bmrange.Text = strText
       .Bookmarks.Add strMarke, bmrange
   End With
End Sub

Sub InsertAutoTextAtBM(strMarke As String, strTextbaustein As String)
'   Dim objWord As Application
'   Set objWord = Application
    Dim bmrange As Variant
    With objWord.ActiveDocument
        Set bmrange = .Bookmarks(strMarke).Range
        Set bmrange = .AttachedTemplate.AutoTextEntries(CStr(strTextbaustein)).Insert(bmrange)
        .Bookmarks.Add strMarke, bmrange
    End With
End Sub
'Einfügen eines Textbausteins in Fußzeile
Sub InsertAutoTextInFooter(strText As String)
'    Dim objWord As Application
'    Set objWord = Application
   
    Dim FooterRange As Variant
   
    With objWord.ActiveDocument
        Set FooterRange = objWord.Selection.Sections(1).Footers(wdHeaderFooterPrimary).Range
        .AttachedTemplate.AutoTextEntries(CStr(strText)).Insert FooterRange
       
        If .PageSetup.DifferentFirstPageHeaderFooter = True Then
            Set FooterRange = objWord.Selection.Sections(1).Footers(wdHeaderFooterFirstPage).Range
            .AttachedTemplate.AutoTextEntries(CStr(strText)).Insert FooterRange
        End If
       
        If .PageSetup.OddAndEvenPagesHeaderFooter = True Then
            Set FooterRange = objWord.Selection.Sections(1).Footers(wdHeaderFooterEvenPages).Range
            .AttachedTemplate.AutoTextEntries(CStr(strText)).Insert FooterRange
        End If
    End With
End Sub

Schaut mal an und sagt was Ihr so dazu meint. Textmarken werden so nicht zerstört und auch nicht so rumhüpferei. Das mit Fusszeile ist wohl noch nicht so toll. Die Frage ist halt was man so am ehesten braucht. Nur die Ansichten wechseln und dann einfügen ist auch nicht toll. (Erste Seite anders und Ungerade Seiten anders und welcher Abschnitt).

Gruss
Remo

[Fedaykin]

Und da euch das wohl das mit Feldern am meisten interessiert hier diese Routine.

'Einfügen von Texten, die als Parameter übergeben werden, in Formularfelder.
Sub InsertInField(strFeld As String, strText As String)
'    Dim objWord As Application
'    Set objWord = Application
    Dim FormFeld As Variant
    Dim IsProtected As Boolean
    Dim Feld As Range
    With objWord.ActiveDocument
        On Error Resume Next
        Set FormFeld = .FormFields(CStr(strFeld))
        On Error GoTo 0
        If Not IsEmpty(FormFeld) Then
            Set Feld = FormFeld.Range
            IsProtected = (.ProtectionType = wdAllowOnlyFormFields)
            If IsProtected Then .Unprotect
            Feld.Fields(1).Result.Text = strText
            If IsProtected Then .Protect wdAllowOnlyFormFields, True
        End If
    End With
End Sub

PS: Wie ihr seht ist der Trick das Formularfeld als Feld zu betrachten. Dann klappen auch Zeilenumschaltungen und längerer Text. Leider muss dafür aber der Dokumentschutz aufgehoben werden.

Gruss
Remo

[Fedaykin]

Hi zusammen

Wieder ich. 

Eigentlich könnte man auch den Unterschied zwischen Textmarke (Bookmark) und Formularfeld (FormField) ganz aufheben. Bei dem Add-In das wir haben ist uns das auf jeden Fall ziemlich Wurst was das eigentlich ist was wir ausfüllen wollen. Schick würde es wenn man das ganze Zeug auch noch mit einer Laufnummer versieht, da muss man aber erst mal Bookmarks (sollten Formularfelder ja auch immer haben) sammeln gehen.

Gruss
Remo

[Axel]

Das sieht doch auf die Schnelle betrachtet doch ganz gut aus.

Dass das mit der Fusszeile nicht der Weisheit letzter Schluss ist, ist mir auch klar. Damals als der Code entstanden ist, war die Dokumentation noch ziemlich besch...(eiden). Der Code resultiert aus einem aufgezeichneten Makro aus Word.

Wenn du eine bessere Lösung hast, dann her damit.


Axel
 

[Fedaykin]

Hi Axel

Das Hauptproblem bei der Kopf/Fusszeile ist halt Du kannst pro Abschnitt 3 Typen haben und die dann je nachdem weiter unten noch umbiegen. Also wird es keine Patentlösung geben. Nur für sonst ist mein Code wohl schicker, da nichts rumhüpft. Bauen so eine Tabelle mit Seitennummern in unsere Fusszeile wenn es mal klappt echt schick. Bis es klappt fluchst Du über Felder und Bereiche. 

Gruss
Remo

[Fedaykin]

Hi Axel

Habe mal versucht InsertAutoTextInFooter wie in der Klasse nachzubauen aber ohne View zu wechseln.

Sub InsertAutoTextInFooter(strText As String)
'    Dim objWord As Application
'    Set objWord = Application
    Dim strCurPage As String
    Dim strCurSection As String
    Dim bolHasFirstPage As Boolean
    Dim bolHasEvenPages As Boolean
    Dim lngHeaderFooterIndex As Long
    Dim rngFooter As Variant
   
    With objWord
        With .Selection
            strCurPage = .Information(wdActiveEndPageNumber)
            strCurSection = .Information(wdActiveEndSectionNumber)
        End With
       
        With .ActiveDocument
            With .Sections(strCurSection).PageSetup
                bolHasFirstPage = .DifferentFirstPageHeaderFooter
                bolHasEvenPages = .OddAndEvenPagesHeaderFooter
            End With
           
            If strCurPage Mod 2 = 0 And bolHasEvenPages Then
                lngHeaderFooterIndex = wdHeaderFooterEvenPages
            Else
                If strCurPage = 1 And bolHasFirstPage Then
                    lngHeaderFooterIndex = wdHeaderFooterFirstPage
                Else
                    lngHeaderFooterIndex = wdHeaderFooterPrimary
                End If
            End If
           
            Set rngFooter = .Sections(strCurSection).Footers(lngHeaderFooterIndex).Range
           
            .AttachedTemplate.AutoTextEntries(CStr(strText)).Insert rngFooter
        End With
    End With
End Sub

Glaube müsste alles sein wie bei Dir, sonst meld Dich und sag was anders ist.

Gruss
Remo

[Axel]

Danke. Ich schau mir's an. Kann aber ein bisschen dauern, da ich im Moment an einer andere Sache dran bin.

Axel