Daten aus Excel in Word übergeben und bestimmte Se
02.11.2016 11:15:13
Scheurer
ich habe ein kleines VBA-Programm geschrieben welches Daten in Excel erstellt und diese dann an Word übergibt und dort Bookmarks ausfüllt.
Nach der Übergabe wird das Word-Dokument gedruckt.
Mein Problem ist das ich es nicht hinbekomme das nur bestimmte Seiten gedruckt werden je nachdem wieviele Bookmarks ausgefüllt wurden.
Es wird immer das ganze Dokument gedruckt oder nichts.
--------------------------------------------------------------
VBA-Code (Alles wird gedruckt)
On Error Resume Next
Set objAppWord = GetObject(, "Word.Application")
On Error GoTo 0
If objAppWord Is Nothing Then
Set objAppWord = CreateObject("Word.Application")
End If
objAppWord.Visible = True
objAppWord.Activate
Set objWordDoc = objAppWord.Documents.Open(pfad2)
For lngZeile = 1 To endzeile
objWordDoc.Bookmarks("Projekt" & lngZeile).Range.Text = Worksheets("Etiketten-Daten").Cells( _
lngZeile + 1, 1)
objWordDoc.Bookmarks("SB" & lngZeile).Range.Text = Worksheets("Etiketten-Daten").Cells(lngZeile _
_
+ 1, 2)
objWordDoc.Bookmarks("Dat" & lngZeile).Range.Text = Worksheets("Etiketten-Daten").Cells( _
lngZeile + 1, 3)
objWordDoc.Bookmarks("Par" & lngZeile).Range.Text = Worksheets("Etiketten-Daten").Cells( _
lngZeile + 1, 4)
objWordDoc.Bookmarks("Nr" & lngZeile).Range.Text = Worksheets("Etiketten-Daten").Cells(lngZeile _
_
+ 1, 5)
On Error Resume Next
Next lngZeile
objAppWord.DisplayAlerts = wdAlertsNone
If Worksheets("Hilfstabelle").Cells(16, 2).Value
objWordDoc.Close wdDoNotSaveChanges
objAppWord.DisplayAlerts = wdAlertsAll
objAppWord.Visible = False
objAppWord.Quit
Unload UserForm1
UserForm1.Show
End Sub
--------------------------------------------------------------
VBA-Code (Nix wird gedruckt)
On Error Resume Next
Set objAppWord = GetObject(, "Word.Application")
On Error GoTo 0
If objAppWord Is Nothing Then
Set objAppWord = CreateObject("Word.Application")
End If
objAppWord.Visible = True
objAppWord.Activate
Set objWordDoc = objAppWord.Documents.Open(pfad2)
For lngZeile = 1 To endzeile
objWordDoc.Bookmarks("Projekt" & lngZeile).Range.Text = Worksheets("Etiketten-Daten").Cells(lngZeile + 1, 1)
objWordDoc.Bookmarks("SB" & lngZeile).Range.Text = Worksheets("Etiketten-Daten").Cells(lngZeile + 1, 2)
objWordDoc.Bookmarks("Dat" & lngZeile).Range.Text = Worksheets("Etiketten-Daten").Cells(lngZeile + 1, 3)
objWordDoc.Bookmarks("Par" & lngZeile).Range.Text = Worksheets("Etiketten-Daten").Cells(lngZeile + 1, 4)
objWordDoc.Bookmarks("Nr" & lngZeile).Range.Text = Worksheets("Etiketten-Daten").Cells(lngZeile + 1, 5)
On Error Resume Next
Next lngZeile
objAppWord.DisplayAlerts = wdAlertsNone
If Worksheets("Hilfstabelle").Cells(16, 2).Value
objWordDoc.PrintOut Background:=False, Range:=wdPrintFromTo, From:="1", To:="1"
Else: objWordDoc.PrintOut Background:=False, Range:=wdPrintFromTo, From:="1", To:="2"
End If
objWordDoc.Close wdDoNotSaveChanges
objAppWord.DisplayAlerts = wdAlertsAll
objAppWord.Visible = False
objAppWord.Quit
Unload UserForm1
UserForm1.Show
End Sub
-----------------------------------------------------
Es wäre super wenn mir dabei jemand helfen könnte.
Gruß
Jens