uitprinten hyperlinks

[kibus]

Hallo,

Ik heb een soort database gebouwd in excel die doorgezet word naar word. de bedoeling is om de gevonden hyperlinks 1 voor 1 uit te printen dit lukt ook wel maar bij meerdere pagina,s print word niet alles uit .... lijkt wel of wordt het niet kan verwerken heeft iemand hier een oplossing ? De code die gebruik staat hier onder

alvast bedankt



Private Sub frm1cmdverder_Click()

On Error GoTo foutje
Selection.GoTo What:=wdGoToBookmark, Name:="beginpunt"
Selection.MoveRight Unit:=wdCharacter, Count:=3

If frm1keus1 = True Then
Unload frm1
Selection.Range.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
ActivePrinter = "\\ - administratie tray3"
Application.printout FileName:="", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
ActiveWindow.Close

herhalen:

Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Range.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
ActivePrinter = "\\- administratie tray3"
Application.printout FileName:="", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
ActiveWindow.Close
On Error GoTo foutje:

GoTo herhalen
Else
If frm1keus2 = True Then
Unload frm1
Selection.GoTo What:=wdGoToBookmark, Name:="beginpunt"
Selection.MoveRight Unit:=wdCharacter, Count:=3
Selection.Range.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
ActivePrinter = "\\ C350 Wit"
Application.printout FileName:="", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
ActiveWindow.Close

herhalen1:

Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Range.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
ActivePrinter = "\\ C350 Wit"
Application.printout FileName:="", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
ActiveWindow.Close
On Error GoTo foutje:

GoTo herhalen1
Else
If frm1keus3 = True Then
Unload frm1
Selection.GoTo What:=wdGoToBookmark, Name:="beginpunt"
Selection.MoveRight Unit:=wdCharacter, Count:=3
Selection.Range.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
ActivePrinter = "2 Tray 4"
Application.printout FileName:="", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
ActiveWindow.Close

herhalen2:

Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Range.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
ActivePrinter = " Tray 4"
Application.printout FileName:="", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
ActiveWindow.Close
On Error GoTo foutje:

GoTo herhalen2
Else
msgbox "geen printer gekozen"
Exit Sub
End If
End If
End If
foutje:

msgbox "klaar", vbInformation, "opdracht voltooid"
End Sub