Hallo Access-Gemeinde,
ich beschäftige mich gerade damit einen Brief in Word aus Access zu starten. Dies klappt soweit ganz gut.
Interessanterweise ist es jetzt so, daß wenn ich die Ereignisprozedur per Button starte es einmal funktioniert.
D.h. der Brief in Word wird erzeugt. Schließe ich nun das Worddokument und starte in Access die Ereignisprozedur erneut, dann wir nur das Standartdocument in Word geöffnet.
Starte ich Access neu, oder Komprimiere und Repariere das Programm, funktioniert es wieder. (Aber auch wieder nur einmal).
Muss ich in dem Vba-Code noch irgendwas ergänzen?
Anbei mal der Code. Es ist nur mal ein Testcode, um zu sehen, ob es funktioniert. Später wird das Accesformular weiter ausgebaut.
Vielen Dank schon mal im vorraus.
Gruß trebuh
Acces Vba-Code:
Private Sub Befehl0_Click()
On Error Resume Next
Dim Word As Object
Set Word = CreateObject("Word.Application") 'Variable initialieren
If Word Is Nothing Then
MsgBox "Es konnte keine Verbindung zu Word hergestellt werden!", 16, "Problem"
Exit Sub
End If
With Word
.Visible = True 'Word sichtbar machen
.Documents.Add 'Neue Worddatei erstellen'
If .ActiveWindow.View.SplitSpecial <> wdPaneNone Then .acticewindow.Panes(2).Close
If .ActiveWindow.View.Type = wdNormalView Or .ActiveWindow.View.Type = _
wdOutlineView Or _
.ActiveWindow.ActivePane.View.Type = wdMasterView Then .ActiveWindow.ActivePane.View.Type = _
wdPageView
'**********************************************************
'Seitenlayout festlegen
With ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(5.5) 'Rand oben
.BottomMargin = CentimetersToPoints(2.2) 'Rand unten
.LeftMargin = CentimetersToPoints(2) 'Rand links
.RightMargin = CentimetersToPoints(1) 'Rand rechts
.Gutter = CentimetersToPoints(0) 'Bundsteg
.HeaderDistance = CentimetersToPoints(1.25) 'Kopfzeile
.FooterDistance = CentimetersToPoints(1.25) 'Fußzeile
.PageWidth = CentimetersToPoints(21) 'Seitengröße (Breite)
.PageHeight = CentimetersToPoints(29.7) 'Seitengröße (Höhe)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
'**********************************************************
'Schriftart und Schriftgröße definieren
With .Selection.Font
.Name = "Arial"
.Size = 11
End With
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Selection.TypeText Text:="Schwärzenbach, den " & Me.txt_akt_Datum.Value
Selection.TypeParagraph
Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="Betreff:"
Selection.Font.Bold = wdToggle
Selection.TypeText Text:=" Test Test Test"
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeText Text:="Sehr geehrte Damen und Herren,"
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeText Text:="Mit freundlichem Gruße"
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeText Text:="Max Mustermann"
AppActivate "Word"
End With
End Sub
Hallo,
Zitat von: trebuh am Januar 16, 2015, 19:51:57Interessanterweise ist es jetzt so, daß wenn ich die Ereignisprozedur per Button starte es einmal funktioniert.
das ist typisches Verhalten im Umgang mit Automatisierung anderer Anwendungen aus Access heraus, wenn dies nicht "sauber" codiert wird.
Du kannst nicht unmittelbar auf Word-Objekte zugreifen, sondern musst stets das zu diesem Zweck initiierte Word-Objekt verwenden.
Also nicht so:
With ActiveDocument.PageSetupsondern so:
With .ActiveDocument.PageSetupWeitere Fälle dieser Art darfst du selber finden. ;-)
PS:
Wo du vielleicht nicht so leicht von allein drauf kommst ist die Word-Funktion "CentimetersToPoints".
Hallo MaggieMay,
zuerst vielen Dank für Deine Antwort.
Nun bin ich einen Schritt weiter. Immerhin wird der Text jetzt immer angezeigt.
Nur das mit dem Seitenränder einrichten klappt noch nicht.
Da passiert jetzt gar nichts mehr (Word Standarteinstellungen) . >:(
Scheinbar hast Du mit Deinem Hinweis die richtige Nase gehabt. ;D
Habe jetzt mal einiges rumprobiert. Leider kein Erfolg!
Und im Internet gibt es zu dem Thema Access mit Word fast so gut wie nichts. (Zumindest was mein Fall betrifft).
In den Handbüchern (Handbucher Access und Access VBA) ist diese Angelegenheit auch etwas dürftig.
Wie muss ich es Programmieren, damit es "sauber" codiert ist?
Kannst Du mir ein Handbuch empfehlen, welches den Umgang mit Automatisierung anderer Anwendungen aus Access heraus ausführlich beschreibt?
Gruß trebuh
ZitatNur das mit dem Seitenränder einrichten klappt noch nicht.
Welchen Programmteil meinst du damit?
ZitatHabe jetzt mal einiges rumprobiert. Leider kein Erfolg!
Vielleicht solltest du den Code deines letzten Versuchs zeigen, damit man das untersuchen kann.
ZitatKannst Du mir ein Handbuch empfehlen
Leider nein, ich habe mir das alles auch nur per Try & Error bzw. Selbststudium angeeignet.
Hallo!
Ich hate mir das mal so zusammen gebastelt vieleicht hilft es dir weiter
du musst aber das ResetWordVorlage nach deinen bedürfnissen anpassen wenn die exe Aktivbleibt dann läuft das modul bei mir ohne probleme ca. 1000 mal in einen ordner zum speichern, zum drucker und per email weg
daher ist der aufruf sub nur ein auszug
gruß Frank
In mdl_Word_Global
Option Compare Database
Option Explicit
Private wordObj As Word.Application
Private wordObjVorlage As Object
Public Property Get CreateWord() As Word.Application
On Error Resume Next
Set wordObj = CreateObject("Word.Application")
If Err <> 0 Or wordObj Is Nothing Then
Err = 0
Set wordObj = CreateObject("Word.Application")
If Err <> 0 Or wordObj Is Nothing Then
Beep
MsgBox "Verbindung zu Word kann nicht aufgebaut werden. " & _
Err.Description, vbOKOnly + vbCritical, "Problem !"
If Not wordObj Is Nothing Then Set wordObj = Nothing
Exit Property
End If
End If
Set CreateWord = wordObj
End Property
Public Function Word_Mit_Vorlage(Vorlage As String, Show As Boolean) As Object
On Error GoTo Err_ErrHandler
' Wenn Instanz geöffnet wieder verwenden
If Not wordObj Is Nothing Then
Set wordObjVorlage = wordObj.Documents.Add(Template:=Vorlage)
' Wenn Instanz nicht vorhanden dann erstellen
End If
If wordObj Is Nothing Then
Set wordObj = CreateWord
wordObj.Visible = Show
Set wordObjVorlage = wordObj.Documents.Add(Template:=Vorlage)
End If
Set Word_Mit_Vorlage = wordObjVorlage
Exit_ErrHandler:
Exit Function
Err_ErrHandler:
If Err <> 0 Then
MsgBox "Vorlage konnte nicht geladen werden. " & _
Err.Description, vbOKOnly + vbCritical, "Problem !"
End If
Call ResetWordVorlage
Resume Exit_ErrHandler:
End Function
Public Sub SetBookmark(wdDok As Object, strBookmark As String, _
varWert As Variant)
If Not wordObj Is Nothing Then
If wdDok.Bookmarks.Exists(strBookmark) Then
With wdDok.Bookmarks(strBookmark).Range
If Trim(Nz(varWert, "")) <> "" Then
.Text = varWert
Else
.Delete
End If
End With
End If
End If
End Sub
Public Function ResetWordVorlage()
On Error Resume Next
'wordObj.Quit ' killt die Word.exe
If Not wordObj Is Nothing Then Set wordObj = Nothing
If Not wordObjVorlage Is Nothing Then Set wordObjVorlage = Nothing
End Function
Aufruf in etwar so und es schreibt da in ein e vorlage die ein steuerelement enthält
Private Sub Word()
Dim wordDoc As Object
On Error GoTo Err_ErrHandler
Set wordDoc = Word_Mit_Vorlage(strVorlage, True)
With wordDoc
SetBookmark wordDoc, "Steuerelementnameinword", Me!Wert
If Me!RahmenDrucken.Value = 1 Then ' Drucken
.SaveAs strNewName
.PrintOut
.Close
End If
If Me!RahmenDrucken.Value = 2 Then ' Erstellen
.SaveAs strNewName
.Close
End If
End With
Exit_ErrHandler:
If Not wordDoc Is Nothing Then Set wordDoc = Nothing
Call ResetWordVorlage
Exit Sub
Err_ErrHandler:
Select Case Err.Number
case ??
Resume Exit_ErrHandler
End Select
End Sub
als buch kann ich das empfehlen
http://www.minhorst.com/index.php/home-73.html
Hallo MaggieMay und Frank77,
@ MaggieMay
Das Problem besteht jetzt noch darin, dass das mit dem "Seitenränder einrichten" (Seitenlayout festlegen) in Word 2010 nur beim ersten aufruf klappt. Danach wird, wie bereits erwähnt, das Standartdokument geöffnet und der Text eingefügt.
anbei nochmal der Code.
Private Sub cmd_Word_Vers_2_Click()
On Error Resume Next
Dim Word As Object
Set Word = CreateObject("Word.Application") 'Variable initialieren
If Word Is Nothing Then
MsgBox "Es konnte keine Verbindung zu Word hergestellt werden!", 16, "Problem"
Exit Sub
End If
With Word
.Visible = True 'Word sichtbar machen
.Documents.Add 'Neue Worddatei erstellen'
If .ActiveWindow.View.SplitSpecial <> wdPaneNone Then .acticewindow.Panes(2).Close
If .ActiveWindow.View.Type = wdNormalView Or .ActiveWindow.View.Type = _
wdOutlineView Or _
.ActiveWindow.ActivePane.View.Type = wdMasterView Then .ActiveWindow.ActivePane.View.Type = _
wdPageView
'**********************************************************
'Seitenlayout festlegen
With .ActiveDocument.PageSetup '
'.LineNumbering.Active = False
'.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(5.5) 'Rand oben
.BottomMargin = CentimetersToPoints(2.2) 'Rand unten
.LeftMargin = CentimetersToPoints(2) 'Rand links
.RightMargin = CentimetersToPoints(1) 'Rand rechts
.Gutter = CentimetersToPoints(0) 'Bundsteg
.HeaderDistance = CentimetersToPoints(1.25) 'Kopfzeile
.FooterDistance = CentimetersToPoints(1.25) 'Fußzeile
.PageWidth = CentimetersToPoints(21) 'Seitengröße (Breite)
.PageHeight = CentimetersToPoints(29.7) 'Seitengröße (Höhe)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
'**********************************************************
'Schriftart und Schriftgröße definieren
With .Selection.Font
.Name = "Arial"
.Size = 11
End With
'**********************************************************
'In den Textteil wechseln und Text eintragen
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
.Selection.TypeText Text:="Musterort, den " & Me.txt_akt_Datum.Value
.Selection.TypeParagraph
.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.Font.Bold = wdToggle
.Selection.TypeText Text:="Betreff:"
.Selection.Font.Bold = wdToggle
.Selection.TypeText Text:=" Test Test Test"
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeText Text:="Sehr geehrte Damen und Herren,"
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeText Text:="Mit freundlichem Gruße"
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeText Text:="Max Mustermann"
AppActivate "Word"
End WithWas hast Du mit:
Zitat
PS:
Wo du vielleicht nicht so leicht von allein drauf kommst ist die Word-Funktion "CentimetersToPoints".
gemeint?
Ich schätze, das es nur wieder eine Kleinigkeit (mit großer Wirkung) sein kann ;D
@ Frank77
Werde mich mit Deinem Code mal auseinandersetzen.
Danke übrigens für den Buchtipp! So was habe ich schon seit längerem gesucht (Vorausgesetzt es entspricht dem was es verspricht).
Habe es mir schon bestellt.
Gruß
trebuh
Hallo!
hab es als beispiel angehängt , ist aber noch nicht perfect was die übergabe der objecte angeht des kann noch verbessert werden
Gruß frank
Zitat von: trebuh am Januar 17, 2015, 08:56:06
Was hast Du mit:
Zitat
PS:
Wo du vielleicht nicht so leicht von allein drauf kommst ist die Word-Funktion "CentimetersToPoints".
gemeint?
Ich schätze, das es nur wieder eine Kleinigkeit (mit großer Wirkung) sein kann ;D
Da diese Funktion sich von Word.Application oder Word.Global ableitet musst du beim Aufruf auch die entsprechende Referenz voranstellen. in deinem Fall probier mal:
Word.CentimetersToPoints
Hallo Frank77 und daolix. :)
@daolix
Danke für den Hinweis. Jetzt funktioniert es. Da wäre ich zuletzt drauf gekommen. Was ich jetzt schon alles ausprobiert habe. Interessant, das zu dem Thema nix im Internet zu finden ist.
@frank77
Merci für den Anhang! Das mit dem Seitenrand einstellen klappt tadellos. Nun habe ich jetzt aber eine Frage:
So wie ich feststellen musste, scheint der Code wieder etwas anders geschrieben zu sein (Ereignissprozedur im Formular1).
Wenn ich jetzt den Code für eine andere Schrift und den Text einfüge, bekomme ich Fehlermeldungen. Füge ich den Makrocode von Word ein, bekomme ich auch Fehlermeldungen. Was gilt es denn jetzt zu beachten? Habe mal verschiedene Varianten mit der With-Anweisung ausprobiert, Aber leider auch ohne Erfolg.
Da bin ich doch noch ein große Access-Laie
Hast Du mir da nochmal einen Tipp?
Gruß
trebuh
...oder eben einfach nur den Punkt voransetzen, da sich der ganze Code ja im "With Word"-Block befindet.
ZitatWenn ich jetzt den Code für eine andere Schrift und den Text einfüge, bekomme ich Fehlermeldungen.
Du musst schon den Code zeigen, damit man etwas dazu sagen kann.
BTW:
Liebe Leute, stellt doch bitte eure Code-Auszüge in
Code-Tags ein.
Hallo trebuh
Wenn der Code einmal durch Access aufgerufen durchläuft und alles so ist wie du es haben willst, könnte es wohl daran liegen das du Variabel oder Objekte im Anfag deines Code aufrust aber sie am Ende nicht wieder zerstörst. Heist im Klartext so Lange deine Anwendung Access geöffnet ist bleiben die Objekte Variabel gefüllt.
Als Beispiel aus deinem Code:
ZitatSet Word = CreateObject("Word.Application") 'Variable initialieren
Wo wird sie am Ende deines Code mit Set Word = Nothing wieder zurück gesetzt?
Ich habe es nicht gefunden, auch nicht mit Brille :D 8)
Hallo Stapi und Hallo MaggieMay.
Zuerst @ Stapi, (denn da ist die Antwort Kürzer ;))
Da kannst Du lange suchen :), denn das habe ich gar nicht berücksichtigt. Und in dem Beispiel aus meienem Access 2010 Handbuch ist das auch nicht drin. (Das ist ja allerhand!)
Ich habe mich jedefalls schon gewundert, wieso es denn einmal klappt. Normalerweise zickt der Computer bei Schreibfehlern ja gleich rum.
Das mit dem zurücksetzen ist von daher eine logische Erklärung. Danke für den Tip.
@ MaggieMay
Sorry, habe gar nicht daran gedacht den Code zu posten, da ich mich geziehlt an Frank77 gewendet habe, weil von ihm der Code ja stammte und der Anhang ja runtergeladen werden kann.
Aber Du hast recht. Schließlich sollen ja auch andere davon profitieren.
Also hier mal der Code:
Dieser ist ja wiederum anders aufgebaut. Das was jetzt bisher an Code klappt, klappt hier wieder nicht. ???
D.h. Wenn ich jetzt den Teil mit Schriftart und Text hier anfüge kommen Fehlermeldungen, welche es vorher ja nicht gab ??? >:( :o
Wie heißt es so schön "Viele Wege führen nach Rom".
Da muss man als Laie erst mal den Durchblick haben.
Option Compare Database
Option Explicit
Private Sub cmd_Word_Click()
Dim Worddatei As Object
Dim i As Integer
Set Worddatei = Word_Ohne_Vorlage(True) ' True für Visible
With Worddatei.PageSetup
.LineNumbering.Active = False
'.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(5.5) 'Rand oben
.BottomMargin = CentimetersToPoints(2.2) 'Rand unten
.LeftMargin = CentimetersToPoints(2) 'Rand links
.RightMargin = CentimetersToPoints(1) 'Rand rechts
.Gutter = CentimetersToPoints(0) 'Bundsteg
.HeaderDistance = CentimetersToPoints(1.25) 'Kopfzeile
.FooterDistance = CentimetersToPoints(1.25) 'Fußzeile
.PageWidth = CentimetersToPoints(21) 'Seitengröße (Breite)
.PageHeight = CentimetersToPoints(29.7) 'Seitengröße (Höhe)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
Call ResetWord
End Sub
Gruß trebuh aus dem leicht verschneiten Südschwarzwald
Das was du da zeigst passt nicht zu dem Ausgangs-Code, so wird das nichts.
Und BITTE poste den Code in CODE-TAGS!
Und wenn es Fehler gibt, nenne bitte die konkrete Fehlermeldung und die betroffene Codezeile.
Hallo MaggieMay,
kurz noch mal die Sachlage:
Dank eurer Hilfe ist mein Problem behoben.
Der Code sieht so aus:
Private Sub cmd_Word_Vers_2_Click()
On Error Resume Next
Dim Word As Object
Set Word = CreateObject("Word.Application") 'Variable initialieren
If Word Is Nothing Then
MsgBox "Es konnte keine Verbindung zu Word hergestellt werden!", 16, "Problem"
Exit Sub
End If
With Word
.Visible = True 'Word sichtbar machen
.Documents.Add 'Neue Worddatei erstellen'
If .ActiveWindow.View.SplitSpecial <> wdPaneNone Then .acticewindow.Panes(2).Close
If .ActiveWindow.View.Type = wdNormalView Or .ActiveWindow.View.Type = _
wdOutlineView Or _
.ActiveWindow.ActivePane.View.Type = wdMasterView Then .ActiveWindow.ActivePane.View.Type = _
wdPageView
'**********************************************************
'Seitenlayout festlegen
With .ActiveDocument.Styles(wdStyleNormal).Font
If .NameFarEast = .NameAscii Then
.NameAscii = ""
End If
.NameFarEast = ""
End With
With .ActiveDocument.PageSetup '
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = Word.CentimetersToPoints(5.5) 'Rand oben
.BottomMargin = Word.CentimetersToPoints(2.2) 'Rand unten
.LeftMargin = Word.CentimetersToPoints(2) 'Rand links
.RightMargin = Word.CentimetersToPoints(1) 'Rand rechts
.Gutter = Word.CentimetersToPoints(0) 'Bundsteg
.HeaderDistance = Word.CentimetersToPoints(1.25) 'Kopfzeile
.FooterDistance = CentimetersToPoints(1.25) 'Fußzeile
.PageWidth = Word.CentimetersToPoints(21) 'Seitengröße (Breite)
.PageHeight = Word.CentimetersToPoints(29.7) 'Seitengröße (Höhe)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
Word.BookFoldPrintingSheets = 1
Word.GutterPos = wdGutterPosLeft
End With
'**********************************************************
'Schriftart und Schriftgröße definieren
With .Selection.Font
.Name = "Arial"
.Size = 12
End With
'**********************************************************
'Schrift einfügen
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
.Selection.TypeText Text:="Schwärzenbach, den " & Me.txt_akt_Datum.Value
.Selection.TypeParagraph
.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.Font.Bold = wdToggle
.Selection.TypeText Text:="Betreff: "
.Selection.Font.Bold = wdToggle
.Selection.TypeText Text:=Me.txt_Betreffeingabe.Value
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeText Text:="Sehr geehrte Damen und Herren,"
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeText Text:="Mit freundlichem Gruße"
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeText Text:="Max Mustermann"
End With
AppActivate "Word"
Set Word = Nothing
End Sub
Frank77 hat mir mit seiner Access-Variante Modul und Formular eine weiter Möglichkeit gezeigt. Hier fehlt jedoch noch die Schriftwahl und das Texteinfügen.
Modul-Code:
Option Compare Database
Option Explicit
Private wordObj As Word.Application
Private wordObjVorlage As Object
Private wordObjDoc As Object
Public Property Get CreateWord() As Word.Application
On Error Resume Next
Set wordObj = CreateObject("Word.Application")
If Err <> 0 Or wordObj Is Nothing Then
Err = 0
Set wordObj = CreateObject("Word.Application")
If Err <> 0 Or wordObj Is Nothing Then
Beep
MsgBox "Verbindung zu Word kann nicht aufgebaut werden. " & _
Err.Description, vbOKOnly + vbCritical, "Problem !"
If Not wordObj Is Nothing Then Set wordObj = Nothing
Exit Property
End If
End If
Set CreateWord = wordObj
End Property
Public Function Word_Ohne_Vorlage(Show As Boolean) As Object
On Error GoTo Err_ErrHandler
If Not wordObj Is Nothing Then
Set wordObjDoc = wordObj.Documents.Add
End If
If wordObj Is Nothing Then
Set wordObj = CreateWord
wordObj.Visible = Show
Set wordObjDoc = wordObj.Documents.Add
End If
Set Word_Ohne_Vorlage = wordObjDoc
Exit_ErrHandler:
Exit Function
Err_ErrHandler:
If Err <> 0 Then
MsgBox "Word konnte nicht geladen werden. " & _
Err.Description, vbOKOnly + vbCritical, "Problem !"
End If
'Call ResetWord
Resume Exit_ErrHandler:
End Function
Public Function Word_Mit_Vorlage(Vorlage As String, Show As Boolean) As Object
On Error GoTo Err_ErrHandler
If Not wordObj Is Nothing Then
Set wordObjVorlage = wordObj.Documents.Add(Template:=Vorlage)
End If
If wordObj Is Nothing Then
Set wordObj = CreateWord
wordObj.Visible = Show
Set wordObjVorlage = wordObj.Documents.Add(Template:=Vorlage)
End If
Set Word_Mit_Vorlage = wordObjVorlage
Exit_ErrHandler:
Exit Function
Err_ErrHandler:
If Err <> 0 Then
MsgBox "Vorlage konnte nicht geladen werden. " & _
Err.Description, vbOKOnly + vbCritical, "Problem !"
End If
Call ResetWord
Resume Exit_ErrHandler:
End Function
Public Sub ResetWord() ' mit.exe zu beenden
On Error Resume Next
wordObj.Quit
If Not wordObj Is Nothing Then
Set wordObj = Nothing
End If
If Not wordObjVorlage Is Nothing Then
Set wordObjVorlage = Nothing
End If
End Sub
Public Sub SetBookmark(wdDok As Object, strBookmark As String, _
varWert As Variant)
If Not wordObj Is Nothing Then
If wdDok.Bookmarks.Exists(strBookmark) Then
With wdDok.Bookmarks(strBookmark).Range
If Trim$(Nz(varWert, "")) <> "" Then
.Text = varWert
Else
.Delete
End If
End With
End If
End If
End Sub
Public Function ResetWordVorlage() 'ohne die .exe zu beenden
On Error Resume Next
If Not wordObj Is Nothing Then
Set wordObj = Nothing
End If
If Not wordObjVorlage Is Nothing Then
Set wordObjVorlage = Nothing
End If
End Function
Formular-Ereignisprozedur-Code:
Option Compare Database
Option Explicit
Private Sub cmd_Word_Click()
Dim Worddatei As Object
Set Worddatei = Word_Ohne_Vorlage(True) ' True für Visible
With Worddatei.PageSetup
.LineNumbering.Active = False
'.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(5.5) 'Rand oben
.BottomMargin = CentimetersToPoints(2.2) 'Rand unten
.LeftMargin = CentimetersToPoints(2) 'Rand links
.RightMargin = CentimetersToPoints(1) 'Rand rechts
.Gutter = CentimetersToPoints(0) 'Bundsteg
.HeaderDistance = CentimetersToPoints(1.25) 'Kopfzeile
.FooterDistance = CentimetersToPoints(1.25) 'Fußzeile
.PageWidth = CentimetersToPoints(21) 'Seitengröße (Breite)
.PageHeight = CentimetersToPoints(29.7) 'Seitengröße (Höhe)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
Call ResetWord
End Sub
Nun wollte ich den fehlenden Teil (welcher in der 1. Variante ja funktioniert)
'**********************************************************
'Schriftart und Schriftgröße definieren
With .Selection.Font
.Name = "Arial"
.Size = 12
End With
'**********************************************************
'Schrift einfügen
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
.Selection.TypeText Text:="Schwärzenbach, den " & Me.txt_akt_Datum.Value
.Selection.TypeParagraph
.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.Font.Bold = wdToggle
.Selection.TypeText Text:="Betreff: "
.Selection.Font.Bold = wdToggle
.Selection.TypeText Text:=Me.txt_Betreffeingabe.Value
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeText Text:="Sehr geehrte Damen und Herren,"
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeText Text:="Mit freundlichem Gruße"
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeText Text:="Max Mustermann"
in die Ereignisprozedur einfügen.
Leider mit keinem Erfolg.
Daher meine Frage:
Wie muss der Code aussehen, damit es funktioniert?
gruß und schönen Sonntag
trebuh
Hallo!
Mir Gings am Anfang auch nicht anders und wenn nicht weist wo du suchen sollst da drehst dich im kreis
wenn du TypeParagraph in Vba Editor markierst und F1 drückst erhält du Infos dazu
Das wird die weiterhelfen
Ich hab dir mal ein Beispiel angehängt das mit einer Vorlage arbeitet und es mal so dargestellt (ich bin auch kein Profi) das du es vielleicht nachvollziehen kannst
Wenn du Call ResetWord aufrufst da ist feierabend
Ich nehme mal an das du bei .Selection.TypeParagraph den fehler bekommst verweis auf ein nicht mehr vorhandenes object
Ich würd sagen arbeite mit einer Vorlage die ist doch eher immer gleich in meiner Vorlage ein Brief im DIN Format
In der Vorlage sind graue Felder die haben einen Namen unter Eigenschaften und die füllst hier z.B. Firma aus einem Recordset also wenn es sein muss 100 am stück
SetBookmark wordDoc, "Firma", rstWord.Fields("Test_Firma")
Wenn es nachvollziehen kannst wie die Sache da abläuft versuch mal den Text Korpus zu füllen
Das mdl_Pfad Gibt an wo die Vorlage ist und wo das Word Doc gespeichert wird
Public Function akt_Verz_vorlage() As String
akt_Verz_vorlage = CurrentProject.Path & "\Vorlage DIN 5008.docx"
End Function
Public Function akt_Verz_vorlage_Save() As String
akt_Verz_vorlage_Save = Environ("UserProfile") & "\Desktop\"
End Function
Hier der Aufruf
Private Sub cmd_Word_Click()
Dim wordDoc As Object
Dim rstWord As DAO.Recordset
Dim ingAnzahl As Long
Dim Msg As String
Dim strSavename As String
On Error GoTo Err_ErrHandler
Set rstWord = CurrentDb.OpenRecordset("tbl_Test", dbOpenSnapshot)
With rstWord
If Not .EOF Then
.MoveLast
ingAnzahl = .RecordCount
.MoveFirst
Msg = " Es werden" & " " & ingAnzahl & " " & "Dokumente erstellt," & vbCr & _
"Sie können den Vorgang an dieser Stelle noch beenden"
If MsgBox(Msg, vbInformation Or vbOKCancel, "Achtung !") = vbOK Then
' OK
DoCmd.Hourglass True
Do Until .EOF
strSavename = akt_Verz_vorlage_Save & .Fields("Test_BriefID") & " " & Format$(Date, "dd.mm.yyyy")
Set wordDoc = Word_Mit_Vorlage(akt_Verz_vorlage, True)
With wordDoc
SetBookmark wordDoc, "Firma", rstWord.Fields("Test_Firma")
SetBookmark wordDoc, "PersAnrede", rstWord.Fields("Test_PersAnrede")
SetBookmark wordDoc, "Name", rstWord.Fields("Test_Name")
SetBookmark wordDoc, "Adresse", rstWord.Fields("Test_Adresse")
SetBookmark wordDoc, "Ort", rstWord.Fields("Test_Ort")
SetBookmark wordDoc, "BriefID", rstWord.Fields("Test_BriefID")
SetBookmark wordDoc, "Betreff", rstWord.Fields("Test_Betreff")
SetBookmark wordDoc, "Anrede", rstWord.Fields("Test_Anrede")
SetBookmark wordDoc, "Datum", Format$(Date, "dd.mm.yyyy")
Select Case Me!RahmenDrucken
Case 1 ' Drucken
.PrintOut
.Close wdDoNotSaveChanges
Case 2 'Speichern
If Dir$(strSavename & ".docx") <> "" Then
Msg = "Die Datei Existiert bereits !" & vbCr & "" & vbCr & "Möchten sie sie ersetzen ?"
If MsgBox(Msg, vbInformation Or vbYesNo Or vbDefaultButton2, "vorhanden !") = vbYes Then
' Ja
.SaveAs strSavename & ".docx"
.Close
Else
' Nein
.Close wdDoNotSaveChanges
End If
Else
.SaveAs strSavename & ".docx"
.Close
End If
Case 3 'Pdf
.ExportAsFixedFormat OutputFileName:=strSavename & ".pdf" _
, ExportFormat:=wdExportFormatPDF _
, OpenAfterExport:=False _
, OptimizeFor:=wdExportOptimizeForPrint _
, Range:=wdExportAllDocument, From:=1, To:=1 _
, Item:=wdExportDocumentContent _
, IncludeDocProps:=True, KeepIRM:=True _
, CreateBookmarks:=wdExportCreateNoBookmarks _
, DocStructureTags:=True _
, BitmapMissingFonts:=True, UseISO19005_1:=False
End Select
Set wordDoc = Nothing
End With
.MoveNext
Loop
Else ' Abbrechen
GoTo Exit_ErrHandler
End If
End If
End With
Exit_ErrHandler:
If Not wordDoc Is Nothing Then Set wordDoc = Nothing
If Not rstWord Is Nothing Then rstWord.Close: Set rstWord = Nothing
Call ResetWord
DoCmd.Hourglass False
Exit Sub
Err_ErrHandler:
Select Case Err.Number
Case 3159 'not a valid bookmark
'???????????
Resume Exit_ErrHandler
Case 91 ' Recordset fehler
'??????
Resume Exit_ErrHandler
Case Else
Resume Exit_ErrHandler
End Select
End Sub
Gruß Frank