Hallo,
ich habe noch ein altes VBA-Skript gefunden, das nur noch entsprechend angepasst werden muss. Das Skript rufst Du am besten über eine Befehlsschaltfläche im Formular auf. Voraussetzung ist allerdings, dass neben ACCESS auch WINWORD auf dem Rechner installiert ist. Die Vorgehensweise ist folgende: Man erstellt eine Dokumentenvorlage (*.dot) in WORD, in der beliebig viele Textmarken festgelegt werden, an die ACCESS die Feldinhalte der Datenbank übergibt. Das Skript „merkt“ im übrigen, ob WORD bereits gestartet ist, nötigenfalls wird es automatisch gestartet. Das erstellte Dokument kann im Anschluss gespeichert werden, ohne dass die Vorlage dadurch geändert wird. Ich hoffe. es hilft weiter. Hier das Skript:
Private Sub Eingangsbestätigung_Click()
On Error GoTo ErrWinWord
Dim objWordApp As Object ’ Verweis auf Microsoft Word.
Dim Bereich As Object ’ Verweis auf Bereich innerhalb des Dokuments (z.B. eine Textmarke)
Dim strVorlage As String
If Not IstWordGestartet Then
DoCmd.Hourglass True
Set objWordApp = CreateObject(„Word.Application“) ’ WinWord starten
DoCmd.Hourglass False
Else
Set objWordApp = GetObject(, „Word.Application“) ’ WinWord war schon gestartet
End If
objWordApp.Visible = True
’ neues Dokument basiert auf Vorlage öffnen
strVorlage = „Pfad\Beispielvorlage.dot“ ’ anpassen
objWordApp.Documents.Add Template:=strVorlage
’ zu den Textmarken springen und Felder einfügen
Set Bereich = objWordApp.ActiveDocument.Goto(What:=GotoBookmark, Name:=„Textmarke1“) ’ anpassen
Bereich.InsertAfter Me!Feldname1 ’ anpassen
Set Bereich = objWordApp.ActiveDocument.Goto(What:=GotoBookmark, Name:=„Textmarke2“) ’ anpassen
Bereich.InsertAfter Me!Feldname2 ’ anpassen
objWordApp.Activate ’ WinWord in den Vordergrund bringen
’ Verweise auf WinWord-Objekte freigeben.
Set Bereich = Nothing
Set objWordApp = Nothing
ExitWinWord:
Exit Sub
ErrWinWord:
Select Case Err.Number
Case 5101
MsgBox „Die Textmarke wurde in der Vorlage nicht gefunden.“, vbCritical
Case 429
MsgBox „Das OLE-Objekt für WinWord konnte nicht erstellt werden.“, vbCritical
Case 5137, 5151
MsgBox „Die Vorlage " & strVorlage & " wurde nicht gefunden.“, vbCritical
Case Else
MsgBox Err.Description, vbCritical
End Select
Resume ExitWinWord
End Sub
Private Function IstWordGestartet() As Boolean
’ Stellt fest, ob WinWord-97 gerade geladen ist
Dim obj As Object
On Error Resume Next
Set obj = GetObject(, „Word.Application“) ’ nach WinWord suchen
IstWordGestartet = (Err.Number = 0)
Set obj = Nothing
End Function
‘ Ab hier geht es nur noch darum, Fehler elegant abzufangen
Private Sub Befehl497_Click()
On Error GoTo Err_Befehl497_Click
DoCmd.GoToRecord , , acFirst
Exit_Befehl497_Click:
Exit Sub
Err_Befehl497_Click:
MsgBox Err.Description
Resume Exit_Befehl497_Click
End Sub
Private Sub Befehl498_Click()
On Error GoTo Err_Befehl498_Click
DoCmd.GoToRecord , , acLast
Exit_Befehl498_Click:
Exit Sub
Err_Befehl498_Click:
MsgBox Err.Description
Resume Exit_Befehl498_Click
End Sub
Private Sub Befehl499_Click()
On Error GoTo Err_Befehl499_Click
DoCmd.GoToRecord , , acNext
Exit_Befehl499_Click:
Exit Sub
Err_Befehl499_Click:
MsgBox Err.Description
Resume Exit_Befehl499_Click
End Sub
Private Sub Befehl500_Click()
On Error GoTo Err_Befehl500_Click
DoCmd.GoToRecord , , acPrevious
Exit_Befehl500_Click:
Exit Sub
Err_Befehl500_Click:
MsgBox Err.Description
Resume Exit_Befehl500_Click
End Sub
Private Sub Befehl501_Click()
On Error GoTo Err_Befehl501_Click
DoCmd.GoToRecord , , acNewRec
Exit_Befehl501_Click:
Exit Sub
Err_Befehl501_Click:
MsgBox Err.Description
Resume Exit_Befehl501_Click
End Sub
Gruß
Hartmut
