Best Practices > Diskussionen zu Best Practices

COM-Schnittstelle MS Word

(1/3) > >>

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

--- Ende Code ---

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

Navigation

[0] Themen-Index

[#] Nächste Seite