www.access-stammtisch.de
Autor: Joachim Jauß
Download der Demo-Dateien
Access-Stammtisch Stuttgart
www.access-stammtisch.de
Autor: Joachim Jauß
Download der Demo-Dateien
Bei größeren Access-Projekten stößt man schnell an die Grenzen
der Access-Berichte. Diese eignen sich wunderbar, um fixe Listen
mit Standardformaten auszugeben, oder auch die ein oder andere
Zeichenfunktion auszugeben.
Meine Lösung heißt hier meist MS Word.
Der Grund besteht darin, dass fest jeder der Access auf seinem System
hat, auch mit Word arbeitet. Zumal ist der Umgang mit MS Word meist vertrauter
als der Umgang mit den Access-Berichten. Somit hat der Anwender die Möglichkeit
selbst Einfluß auf die Gestaltung zu nehmen.
Dies ist meist die zweite Frage die kurz nach der Entscheidung zur Ausgabe an Word folgt. Nachdem die Daten an Word abgeschickt wurden, weiß Access nichts mehr von Word. Word läuft als Exe-Server in einem eigenen Adressraum und kann nicht ohne weiteres wieder zu Access zurück.
Hier liegt der Ansatz für die folgende Demo:
Zugrunde liegt die Access-Anwendung WrdDemo.mdb (Access 97) sowie die
Word-Vorlage Brief.dot. Die Word-Vorlage ist für diesen speziellen Einsatz
etwas präpariert.
Sie enthält die für die Positionierung vorgesehenen Textmarken
"Anrede", "Name", "Strasse", "Ort" und "Betreff".
Und ein wenig VBA-Code der es ermöglicht, dass Word den Dateinamen in der
Access-Datenbank selbst speichert.
Die Access-Anwendung enthält zwei Tabellen namens USysSettings in welcher der
Pfad für die Vorlagendatei gespeichert wird, sowie eine Tabelle tblBriefe, in
der die Briefe verwaltet werden. Das Formular frmWrdDemo wurde als Oberfläche
entworfen. Als Kernstück für die Interaktion verwende ich eine separate
Klasse "clsWord" die ich selbst ständig um weitere Methoden und Eigenschaften
erweitere.
Option Compare Database
Option Explicit
Private objWord As Word.Application
Private objWordDoc As Word.Document
Private objRange As Word.Range
Private Const WORD_INITSTRING = "Word.Application"
Private Const TWIPS = 567 'Ein Zentimeter = 567 twips
'#################################################################################
'Setzt den Wert einer Textmarke
'SetWordBookmark
' strBookmark = Name der Texmarke
' strText = Text der eingefügt werden soll
' bInsert = Fügt eine neue Textmarke in das Dokument ein (Standard = False)
' lngStartPosition = Die Startposition an der die Textmarke eingefügt werden soll
'
' Rückgabewert : Wurde eine neue Textmarke eingefügt, das Ende der Textmarke
' : Konnte keine neue Textmarke einefügt werden lngStartPosition
Public Function SetWordBookmark(strBookmark As String, _
strText As String, _
Optional bInsert As Boolean = False, _
Optional lngStartPosition As Long = 0) As Long
Dim objWordBookmark As Word.Bookmark
Dim objWordRange As Word.Range
Dim intLength As Integer
intLength = Len(strText)
If bInsert Then
If Not objWordDoc.Bookmarks.Exists(strBookmark) Then
Set objWordRange = objWordDoc.Range(lngStartPosition, lngStartPosition)
objWordDoc.Bookmarks.Add strBookmark, objWordRange
End If
End If
If objWordDoc.Bookmarks.Exists(strBookmark) Then
Set objWordBookmark = objWordDoc.Bookmarks(strBookmark)
objWordBookmark.End = objWordBookmark.Start
objWordBookmark.Range.Text = strText
objWordBookmark.End = objWordBookmark.Start + intLength
SetWordBookmark = objWordBookmark.End
objRange.Start = objWordBookmark.End
objRange.End = objRange.Start
Else
SetWordBookmark = lngStartPosition
End If
End Function
'Öffnet ein Dokument oder erstellt ein neues Dokument aufgrund einer Vorlage
Public Function OpenDoc(strDocument As String, bIsTemplate As Boolean) As Word.Document
If bIsTemplate Then
Set objWordDoc = objWord.Documents.Add(Template:=strDocument)
Else
Set objWordDoc = objWord.Documents.Open(strDocument, , , False)
End If
Set objRange = objWord.ActiveDocument.Range
objRange.Start = 1
objRange.End = objRange.Start
'benutzerdefinierte Eigenschaft des Word-Dokuments ansprechen
On Error Resume Next
objWordDoc.DataFilename = CurrentDb.Name
Err = 0
On Error GoTo 0
Set OpenDoc = objWordDoc
End Function
Public Sub Show()
objWordDoc.Windows(1).View.ShowBookmarks = False
objWord.Visible = True
objWord.WindowState = wdWindowStateMaximize
objWord.Activate
End Sub
Private Sub Class_Initialize()
'Initialisieren der Objekt-Variablen
Set objWord = Nothing
Set objWordDoc = Nothing
Set objRange = Nothing
'Initialisieren des Word-Objectes
On Error Resume Next
Set objWord = GetObject(, WORD_INITSTRING)
If Err Then
Set objWord = New Word.Application
End If
On Error GoTo 0
End Sub
Private Sub Class_Terminate()
Set objRange = Nothing
Set objWordDoc = Nothing
Set objWord = Nothing
End Sub
Damit das Ganze auch funktioniert sollte über Extras/Verweise ein Verweis auf die Word-Bibliothek gesetzt werden.
Der Code, der sich hinter dem Formular versteckt, beschränkt sich darauf
eine Objektvariable des Typs clsWord anzulegen und die entsprechenden
Methoden in der richtigen Reihenfolge aufzurufen.
Auf eine differenzierte Fehlerbehandlung hab ich der Einfachheit halber verzichtet.
Etwas ungewöhlicher wird es, wenn wir den Code hinter der Word-Vorlage anschauen.
'Konstanten für den Zugriff auf die Access-Datenbank
Private Const VAR_DATAFILE = "varDataFile"
Private Const TBL_NAME = "tblBriefe"
Private Const TBL_BETREFFFELD = "Betreff"
Private Const TBL_FILENAMEFIELD = "Datei"
Private Const DIALOG_TITLE = "Word - Demo"
Zunächst einmal habe ich die Vorlage und somit auch den späteren Brief um die Eigenschaft DataFilename erweitert. Dies funktioniert wie in Access auch mit den Property Get / Property Let - Prozuduren.
Public Property Get DataFilename() As String On Error Resume Next DataFilename = Me.Variables.Item(VAR_DATAFILE).Value End Property Public Property Let DataFilename(strDataFilename As String) On Error Resume Next Me.Variables.Add Name:=VAR_DATAFILE, Value:=strDataFilename End Property
Die Property Let - Prozedur fügt dem Dokument eine neue benutzerdefinierte Variable
hinzu, die ihren Inhalt auch über die Laufzeit der aktuellen Word-Sitzung hinaus
behält. In Ihr wird der Pfad zu Access-Datendatei gespeichert in der sich die
Tabelle für die Briefverwaltung befindet.
Die Property Get - Funktion liefert den Inhalt der Variablen.
Leider löst das Document-Objekt von Word zum Zeitpunkt des Speichern kein Ereignis aus. Aus diesem Grund wird beim Ereignis Document_Close überprüft, ob das Dokument auch gespeichert wurde. Ist dies nicht der Fall, bekommt der Anwender noch vor der Word-eigenen Aufforderung zum Speichern eine Messagebox angezeigt. Bestätigt er dies mit ja, wird der Save-Dialog von Word aufgerufen und das Dokument gespeichert.
Die Do Until...Loop zwingt den Benutzer entweder zu speichern, oder in der dokumenteneigenen Meldung auf Nein zu klicken. Anschließend wird die Eigenschaft DataFilename ausgelesen. Der folgende Code dürfte den eingefleischten Access-Programmierern bekannt sein. Eine Access-Datei wird in einem eigenen Arbeitsbereich geöffnet und in eine Tabelle ein neuer Datensatz eingetragen. Um nun die Aufforderung zum Speichern von Word zu verhindern, wird die Saved-Eigenschaft des Dokuments auf True gesetzt.
'Das Ereignis Close wird von Word aufgerufen, wenn das
'Dokument geschlossen wird.
'Zuerst wird geprüft, ob das Dokument gespeichert wurde und
'die Dokumentvariablen mit Werten gefüllt sind.
Private Sub Document_Close()
Dim ws As Workspace
Dim db As DATABASE
Dim rsBriefe As RECORDSET
Dim strDataFilename As String
Dim strTablename As String
Dim bDocIsSaved As Boolean
'Prüfen ob das Dokument schon gespeichert wurde
bDocIsSaved = Me.Saved
Do Until bDocIsSaved
If (MsgBox("Das Dokument ist noch nicht gespeichert!" & vbCrLf & _
"Möchten Sie nun speichern?", vbYesNo, DIALOG_TITLE) = vbYes) Then
On Error Resume Next
'Beim Abbrechen des Speicherns durch den Benutzer tritt der
'Fehler 4198 auf
Me.Save
bDocIsSaved = Me.Saved
Else
bDocIsSaved = True
End If
Loop
On Error GoTo 0
strDataFilename = CStr(Me.DataFilename)
'Wenn gültige Werte eingetragen wurden:
If Me.Saved Then
If (Len(strDataFilename) > 0) Then
Set ws = DBEngine.CreateWorkspace("WordSpeicherFunktion", "Admin", "")
If (Len(Dir(strDataFilename)) > 0) Then
Set db = ws.OpenDatabase(strDataFilename)
Set rsBriefe = db.OpenRecordset(TBL_NAME, dbOpenDynaset)
rsBriefe.AddNew
rsBriefe.Fields(TBL_BETREFFFELD) = Me.Bookmarks("Betreff").Range.Text
rsBriefe.Fields(TBL_FILENAMEFIELD) = Me.Path & "\" & Me.Name
rsBriefe.Update
rsBriefe.Close
db.Close
Else
MsgBox "Der Dateipfad der Datendatei hat sich geändert!" & _
" Ein Speichern des Dateinamens ist nicht möglich", vbOKOnly, DIALOG_TITLE
End If
ws.Close
Else
MsgBox "Die Dokumentvariablen enthalten ungültige Werte." & vbCrLf & _
"Die Datendatei kann deshalb nicht aktualisiert werden.", vbOKOnly, DIALOG_TITLE
End If
End If
Me.Saved = True
End Sub