Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

twee afdrukbereiken op 1 pagina printen

715 views
Skip to first unread message

Piet Robe

unread,
Sep 21, 2002, 3:31:45 AM9/21/02
to
Beste mensen,
door middel van een knop op een werkblad laat ik een bepaald gedeelte van
een werkblad printen. (=printoverzicht gemaakt met invoegen naam)

Private Sub CommandButton1_Click()
Dim Waarde1 As Integer
Dim Waarde2 As Integer
Waarde1 = InputBox("Vanaf welk nummer printen:")
Waarde2 = InputBox("Tot en met welk nummer printen:")
Application.ScreenUpdating = False
For i = Waarde1 To Waarde2
Range("B2") = i
DoEvents
Range("PrintOverzicht").Select
Selection.PrintOut Copies:=1
Next
Application.ScreenUpdating = True
End Sub

Als het mogelijk is wil ik ook eigenlijk twee afdrukbereiken (printoverzicht
(=OverzichtHW!$A$1:$I$23) en de nieuwe
printoverzichtextra(=OverzichtHW!$v$1:$ad$23) op een pagina printen (het
zijn twee verschillende blokken) en in een doorgang en dan ook nog
onderelkaar.

Is dat mogelijk?
Met vriendelijke groet
Piet Robe

(to reply to sender remove DITVERWIJDEREN from emailadress)


keepitcool

unread,
Sep 21, 2002, 6:52:46 AM9/21/02
to
Piet,

Afhankelijk van je printerdriver zijn er wellicht mogelijkheden om
meerdere "pagina's" op 1 vel papier af te drukken.

Excel zelf zal bij "MultiArea" print ranges per "Area" ten minste één
pagina afdrukken.

Indien mogelijk (en in jouw voorbeeld is t mogelijk) tussenliggende
kolommen/rijen (tijdelijk) verbergen, om zodoende een PrintRange van 1
"Area" af te kunnen drukken.

Jouw PrintArea/Afdrukbereik wordt dan: A1:AD23, terwijl de kolommen
J t/m U zijn verborgen.

Private Sub CommandButton1_Click()
Dim Waarde1%, Waarde2%

invoer:


Waarde1 = InputBox("Vanaf welk nummer printen:")
Waarde2 = InputBox("Tot en met welk nummer printen:")

If Waarde2 < Waarde1 Then Beep:GoTo invoer

Application.ScreenUpdating = False
With ActiveSheet
.PageSetup.PrintArea = "$A$1:$AD$23"
.Range("J:U").EntireColumn.Hidden = True


For i = Waarde1 To Waarde2

.Range("B2") = i
DoEvents
.PrintOut Copies:=1
Next
.Range("J:U").EntireColumn.Hidden = False
End With


Application.ScreenUpdating = True
End Sub


Greetz,
KeepItCool
<unscramble emailaddress with ROT13>

"Piet Robe" <p_robeDITV...@hotmail.com> wrote in message
news:uLo5CSVYCHA.2464@tkmsftngp11 ...

J.G. Kok

unread,
Sep 21, 2002, 7:17:24 AM9/21/02
to
Piet,

Er zit denk ik niks anders op dan de waarden van beide gebieden naar een
apart blad te kopieėren en dat blad vervolgens af te drukken.

In onderstaande code ben ik er van uitgegaan dat je een blad met de naam
"AfdrukBlad" hebt toegevoegd aan de collectie werkbladen (Dit zou je
desnoods ook via de code kunnen doen en het blad aan het eind weer laten
verwijderen)

Dit blad wordt voor elke afdruk leeggemaakt.
De waarden uit beide gebieden worden er in geplakt met een tussenruimte van
5 rijen.
Daarna wordt dit blad afgedrukt.

Option Explicit

Private Sub CommandButton1_Click()
Dim Waarde1 As Integer
Dim Waarde2 As Integer

Dim shHW As Worksheet
Dim shAfdr As Worksheet
Dim i As Integer


Waarde1 = InputBox("Vanaf welk nummer printen:")
Waarde2 = InputBox("Tot en met welk nummer printen:")
Application.ScreenUpdating = False
For i = Waarde1 To Waarde2

Range("A2") = i
DoEvents
Set shHW = Sheets("OverzichtHW")
Set shAfdr = Sheets("Afdrukblad")
'Afdrukbklad leegmaken
shAfdr.UsedRange.Clear
'overzetten van de waarden naar AfdrukBlad
shHW.Range("PrintOverzicht").Copy
shAfdr.Range("A1").PasteSpecial xlPasteValues
shHW.Range("PrintOverzichtExtra").Copy
shAfdr.UsedRange.Offset(shAfdr.UsedRange.Rows.Count + 5, 0).Cells(1,
1).PasteSpecial xlPasteValues
Application.CutCopyMode = False

shAfdr.PrintOut Copies:=1


Next
Application.ScreenUpdating = True
End Sub

Kom je hier verder mee?

Jan


Piet Robe

unread,
Sep 21, 2002, 7:16:56 AM9/21/02
to
Beste keepitcool"
Zo had ik het inderdaad ook opgelost maar was benieuwd of het ook op een
andere manier kon.
Bedankt voor de aanpssing van de routine met

If Waarde2 < Waarde1 Then Beep:GoTo invoer

Het is nu nog beter.
Piet

"keepitcool" <xrrcv...@puryyb.ay> schreef in bericht
news:Xns92908301C34...@207.46.239.39...

keepitcool

unread,
Sep 21, 2002, 8:04:16 AM9/21/02
to
maar die opl van J.G. Kok lost je probleem op en print t netjes onder
elkaar. dat was ik ff vergeten.

krijg ik die mail uit de andere thread nog van je?

Greetz,
KeepItCool
<unscramble emailaddress with ROT13>

"Piet Robe" <p_robeDITV...@hotmail.com> wrote in message

news:#5F#OQWYCHA.1860@tkmsftngp08 ...

Piet Robe

unread,
Sep 21, 2002, 7:56:20 AM9/21/02
to
Beste Jan,
Zo op papier is dit een andere weg naar Rome.
Ik zal het eens op deze manier proberen gewoon omdat ik weer iets van kan
leren.
leegmalen - overzetten - afdrukken
Piet
"J.G. Kok" <jgko...@789freeler.nl> schreef in bericht
news:e2diKAWYCHA.2016@tkmsftngp09...

Piet Robe

unread,
Sep 21, 2002, 9:01:30 AM9/21/02
to
Jan
Die is die mooi en goed
bedankt
Piet


william

unread,
Sep 21, 2002, 1:39:49 PM9/21/02
to
Hallo Keep It Cool,

Dat programma van die 2 afdruk bereiken wil ik ook wel gebruiken, maar hoe?

alt F11 of alt F8, daarna - kopieren en plakken, en dan uitvoeren? Of hoe
start ik hem op, en geef ik ook het bereik op?

groeten william


Piet Robe

unread,
Sep 22, 2002, 7:22:56 AM9/22/02
to
Wiiliam,
Je maakt een knop
ga er op staan een klik met de rechter muis knop
programma code
Er verschijnt dan het volgende in hnet scherm
Private Sub CommandButton1_Click()

End Sub

code van Jan in voegen
opslaan werkblad
opnieuw opstarten
en het zal werken.

Denk er wel aan dat mijn afdrukbereiken in het voorbeeld van Jan zijn
benoemd.
Kun natuurlijk altijd zelf aanpassen door gebied te selecteren
invoegen naam
enz.

Groet
Piet
"william" <wti...@hotmail.com> schreef in bericht
news:1032629976.303191@cache2...

william

unread,
Sep 22, 2002, 7:42:47 AM9/22/02
to
Hallo Piet,

Bedankt voor de uitleg ik ga er mee aan de slag, ik ben op het Internet op
zoek naar voorbeelden en cursussen over VBA, Macro's.
Jouw uitleg heeft me al een stuk verder gebracht.

groeten William


0 new messages