Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

serienbrief drucken

Betrifft: serienbrief drucken von: Michael Staller
Geschrieben am: 17.09.2004 20:04:08

Hallo Leute;

ich haben ein Problem. Ist es möglich den Druckvorgang eines Seriebriefs in Word über ein Excel-Makro zu starten. Dann müsste ich nicht jedesmal word starten.

Kann mir jemand helfen?
Danke

mfg
Michael

  


Betrifft: AW: serienbrief drucken von: andre
Geschrieben am: 17.09.2004 21:45:34

Hallo Michael,
Einen Verweis auf Microsoft Word... setzen
Sub SerienDruckUndTexteErsetzen()
'
' Makro am 20.05.2004 von SchauAn
' Stand 15.08.04 / 20:33 Uhr
' Variablen und Konstanten für Word
Dim wordObj As Word.Application
Dim DeinDateiName As String
' Variablen für Excel
Dim DatenQuelle As String


' Hier den Standard-Namen des Haupddokument eintragen
' wenn nicht vorhanden, Eintrag aus A1 in Blatt Admin
DeinDateiName = InputBox("Eingabe Hauptdokument: ", "Hauptdokument", _
ThisWorkbook.Sheets("Admin").[a1])
If DeinDateiName = "" Then DeinDateiName = ThisWorkbook.Sheets("Admin").[a1]

' Document öffnen
Set wordObj = CreateObject("Word.Application")

wordObj.Visible = False

On Error GoTo nixda
wordObj.Documents.Open DeinDateiName

With wordObj
' erst mal der Seriendruck
  With .ActiveDocument.MailMerge
On Error GoTo errorhandler
     .Destination = wdSendToNewDocument
On Error GoTo 0
     .SuppressBlankLines = True
     With .DataSource
       .FirstRecord = wdDefaultFirstRecord
       .LastRecord = wdDefaultLastRecord
     End With
     .Execute Pause:=False
  End With

' Speichern des Serienbriefes unter ...
' wordObj.ActiveDocument.SaveAs ("C:\test\serientest.doc")
On Error GoTo nixda

' Abfrage des Namens für das Serienbriefdokument
' wenn nicht vorhanden, Eintrag aus A2 in Blatt Admin
  DeinDateiName = InputBox("Eingabe Serienbriefname", "Serienbriefname", ThisWorkbook.Sheets("Admin").[a2])
  If DeinDateiName = "" Then DeinDateiName = ThisWorkbook.Sheets("Admin").[a2]
  wordObj.ActiveDocument.SaveAs (DeinDateiName)

' Schließen aller offenen Documente ohne Speichern
On Error Resume Next
  For i = 1 To 3
    wordObj.ActiveDocument.Close False
  Next
On Error GoTo 0

wordObj.Application.Quit     'hier sollte man noch eine Fehlerbehandlung einbauen
                             'damit bei einem Abbruch nicht das wordobj offen bleibt !
End With

' MsgBox "Fertig" & Chr(10) & "gespeichert unter: C:\test\serientest.doc"
MsgBox "Fertig" & Chr(10) & "gespeichert unter: " & DeinDateiName

Exit Sub
' Fehlerbehamndlung - Anlage des Serienhauptdokumentes
errorhandler:
If Err.Number = 5852 Then
    With wordObj.ActiveDocument.MailMerge
      .MainDocumentType = wdFormLetters

' das Verzeichnis und Quelldatei wird aus dem Blatt Admin [a1] geholt
DatenQuelle = InputBox("Eingabe Hauptdokument: ", "Hauptdokument", _
ThisWorkbook.Sheets("Admin").[a3])
If DatenQuelle = "" Then DatenQuelle = ThisWorkbook.Sheets("Admin").[a3]
' oder alternativ ohne Inputbox, dann die beiden anderen Zeilen auskommentieren
' DatenQuelle = ThisWorkbook.Sheets("Admin").[a3]

' Daten auf Blatt Test1, bei anderem Namen entsprechend ändern
' (Zeile mit SELECT * FROM `Test1 ...)
      .OpenDataSource Name:=DatenQuelle, _
        LinkToSource:=True, Format:=wdOpenFormatAuto, Connection:= _
        "Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source=" & _
        DatenQuelle & ";Mode=Read;Extended Properties="";HDR=YES;IMEX=1;"";Jet  OLEDB:Engine Type=35" _
        , SQLStatement:="SELECT * FROM `Test1$`", SQLStatement1:="", SubType:= _
        wdMergeSubTypeAccess
' wenn nötig Langversion - Achtung, Begrenzung maximale Anzahl Zeichen für den Befehl
' wird durch Pfadlänge weiter eingeschränkt!
'      .OpenDataSource Name:=DatenQuelle, _
        ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
        AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
        WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
        Format:=wdOpenFormatAuto, Connection:= _
        "Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" &   DatenQuelle & _
        ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database _ 
        Password="""";Jet OLEDB:Engine Type=35" _
        , SQLStatement:="SELECT * FROM `Test1$`", SQLStatement1:="", SubType:= _
        wdMergeSubTypeAccess
        ' vor HDR=YES war kein Semikolon, manuell nachgetragen, Auswirkung = ???
    End With
Resume
End If

nixda:
If Err.Number = 5273 Then
MsgBox "Pfad -->" & DeinDateiName & " <-- nicht gefunden !" & Chr(10) & _
    "Programm wird beendet!"
End If
If Err.Number = 5174 Then
MsgBox "Datei -->" & DeinDateiName & " <-- nicht gefunden !" & Chr(10) & _
    "Programm wird beendet!"
End If

On Error Resume Next
wordObj.Application.Quit

End Sub




  


Betrifft: AW: serienbrief drucken von: Michael
Geschrieben am: 18.09.2004 18:07:09

Leider funktioniert das Makro bei mir nicht. Ginge es auch etwas einfacher.
Der Serienbrief in Word ist schon fertig. Ich möchte nur den Ausdruck über Excel starten um nicht jedesmal word starten zu müssen.

danke
michael


  


Betrifft: AW: serienbrief drucken von: andre
Geschrieben am: 18.09.2004 21:14:56

hallo Michael,
natürlich ginge es einfacher. Ich hatte nur das Problem, dass Word manchmal den Sereinbriefbezug vergisst und daher ist es etwas mehr.
Bei den Eingaben kannst Du ja selber kürzen was Dir zu viel ist - z.B. die Eingaben weglassen und die Dateinamen an den benötigten Stellen direkt programmieren ...
Und ohne die Fehlerbehandlung ist das Makro bei Exit Sub fertig.


 

Beiträge aus den Excel-Beispielen zum Thema "serienbrief drucken "