Kiezen wat te printen in Word

[brammetje82]

Hoi Joost,

Ik heb er nog even na gekeken en bener nu achter waar de boel foutloopt en dat is bij de volgende (dikgedrukte) regel:

Sub PrintEachDoc()
Dim oApp As Word.Application
Dim intCount As Long
Dim blnMM As Boolean
Dim sDefault As String
Dim sCount As String

On Error GoTo Err_PrintDoc

Set oApp = Application
With oApp
.DisplayAlerts = False
.ScreenUpdating = False
sDefault = .ActivePrinter
.ActivePrinter = "\\SIEM-CS-ALA\vernietigen/poststukken"
'de printstring kan eventueel nog voor problemen zorgen..(
'moeten we even afwachten)
With .ActiveDocument.MailMerge
blnMM = False
intCount = 1

Do Until blnMM
.DataSource.ActiveRecord = intCount
sCount = .DataSource.DataFields("poststuk_aantal").Value
If .DataSource.ActiveRecord <> intCount Then
blnMM = True
Else
.DataSource.FirstRecord = intCount
.DataSource.LastRecord = intCount
.Destination = wdSendToNewDocument
.Execute
With oApp.ActiveDocument
.PrintOut Range:=wdPrintFromTo, Background:=False, _
Copies:=sCount, From:="1", To:="1", Collate:=True
.PrintOut Range:=wdPrintFromTo, Background:=False, _
Copies:="1", From:="2", To:="2", Collate:=True
.Close False
End With
End If
intCount = intCount + 1
Loop
End With

Exit_PrintDoc:
.ActivePrinter = sDefault
.DisplayAlerts = True
.ScreenRefresh
.ScreenUpdating = True
End With
Set oApp = Nothing
Exit Sub

Err_PrintDoc:
MsgBox "Code uitvoering wordt beëindigd door storing: " & vbCr & _
Err.Number & " " & Err.Description
Resume Exit_PrintDoc

End Sub



Vooralsnog lijk het erop dat hij zoekt naar dat veld "Detail" maar als je de code laat tellen naar het aantal velden vindt ie er geen. Terwijl er in het document toch 5 aanwezig zijn..

groetjes
Bram

 

[joost verdaasdo]

Hai Bram,

Zoals eerder gezegd kan ik deze fout alleen maar dupliceren als de samenvoegbrief niet gekoppeld is aan het gegevensbestand!

Dus de brief waar vanuit jij normaal gesproken de samenvoeging (handmatig) start is dus de samenvoegbrief. In die Samenvoegbrief moet deze code staan en uitgevoerd worden..

Controleer met de recordknopje vorig en volgend of dit bestand gekoppeld is met de gegevensdatabase en of je de code inderdaad in dit document hebt staan en dat je de code vanuit dit document start...

Helaas zit je toch te ver van mij af anders was ik allang een keer die kant in gestormd!

Ik zou willen dat ik het beter uit kon leggen aan je maar ik heb al zoveel verteld....en bij mij werkt het echt zonder problemen...(Zal echt iets simpels zijn alleen ik zou niet weten wat er bij jou mis gaat)

Wederom succes! :thumb:

 

[joost verdaasdo]

Geplaatst door brammetje82
Die jupiler blijft nog koel staan

Die is ondertussen wel koud zat hoor!

 

[brammetje82]

Hee Joost en andere lezers,

Tis alweer een tijdje geleden maar ik wou toch nog ff laten weten dat het gelukt is. Een nieuwe collega van me heeft mbv jou macro een nieuwe macro gemaakt. Het geheel werkt nu perfect. Bedankt voor alle moeite.

Gr Bram

Ps de code is als volgt geworden:

Option Explicit

Public Sub PrintEachDoc()
Dim oMerge As Word.MailMerge
Dim sDefault As String
Dim lr As Integer
Dim fr As Integer
Dim i As Integer
Dim Count As String
Dim ProcessLastRecord As Boolean

On Error GoTo Err_PrintDoc

Application.DisplayAlerts = False
Application.ScreenUpdating = False
sDefault = Application.ActivePrinter
Application.ActivePrinter = "\\yben018658\vernietigen/poststukken"

Set oMerge = Application.ActiveDocument.MailMerge

oMerge.DataSource.ActiveRecord = wdLastRecord
lr = oMerge.DataSource.ActiveRecord
oMerge.DataSource.ActiveRecord = wdFirstRecord
fr = oMerge.DataSource.ActiveRecord
ProcessLastRecord = CBool(lr = fr)
i = fr

While oMerge.DataSource.ActiveRecord <> lr Or ProcessLastRecord
'Print this record DETAIL times
oMerge.DataSource.FirstRecord = i
oMerge.DataSource.LastRecord = i

If CInt(oMerge.DataSource.DataFields("Detail").Value) <= 0 Then
Count = "1"
Else
Count = oMerge.DataSource.DataFields("Detail").Value
End If

oMerge.Application.PrintOut Copies:=Count, From:=CStr(i), To:=CStr(i)

i = i + 1

oMerge.DataSource.ActiveRecord = wdNextRecord

If Not ProcessLastRecord Then
If oMerge.DataSource.ActiveRecord = lr Then
ProcessLastRecord = True
End If
Else
ProcessLastRecord = False
End If
Wend

MsgBox "Klaar met afdrukken!"

Exit_PrintDoc:
Application.ActivePrinter = sDefault
Application.DisplayAlerts = True
Application.ScreenRefresh
Application.ScreenUpdating = True
Set oMerge = Nothing
Exit Sub

Err_PrintDoc:
If Err.Number = 13 Then
Count = "1"
Resume Next
End If
MsgBox "Code uitvoering wordt beëindigd door storing: " & vbCr & _
Err.Number & " " & Err.Description
Resume Exit_PrintDoc

End Sub