Hier gleich mal eine Klasse mit einigen Grundfunktionen.
'--- 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 (http://atnotes.de/index.php?topic=34333.0) zu finden.
Axel