Selectief printen middels invoermacro

Status
Niet open voor verdere reacties.

litmanen65

Gebruiker
Lid geworden
25 jun 2004
Berichten
24
Probleempje waar ik (wederom) niet uitkom.

Ik heb een bestand met 50 werkbladen.
Ik wil een printmacro over (een gedeelte) van deze werkbladen uitvoeren.
Macro moet vragen "printen werkblad nummer ...." "tot en met werkbladnummer .......", zodat ik niet elke keer alle werkbladen hoef te printen.


Alvast bedankt.

Jan
 
Hai Jan, :D

Zoiets misschien:
Code:
Sub WbPrintOut()
Dim iStart  As Integer
Dim iEnd    As Integer
Dim i       As Integer

 iStart = InputBox("Bij welk blad begin ik")
 iEnd = InputBox("Bij welk blad wil je eindigen")
 
 For i = iStart To iEnd
    Sheets(i).PrintOut
 Next i
 
End Sub

Je kunt eventueel in de code nog controleren op foute invoer..maar als het alleen voor jezelf is dan lijkt me dit voldoende.

See Yah! :thumb:
 
Bedankt voor je supersnelle response, maar ik kom zelf niet verder (door mijn te berperkte kennis van VBA). Onderstaand is mijn bestaande macro voor het actieve werkblad. Hoe bouw ik deze ins hemelsnaam om zodat de door jou aangedragen oplossing werkt ?


ActiveSheet.Unprotect
Range("D4:D118").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="<>"
Range("C6").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Selection.AutoFilter
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
 
Hai Jan, :D

Bovenstaande macro lijkt opgenomen? (Overbodige statements)

Wil je even precies uitleggen wat die macro volgens jou precies moet doen?

En is het nu ook de bedoeling dat dezelfde actie ook uitgevoerd wordt op de andere werkbladen welke jij ingeeft in de door mij getoonde macro?

Of te wel bv: in sheet 1 t/m 3 Selecteer die range pas autofilter toe en printen die hap?

Laat maar weten? :thumb:
 
Hai Jan, :D

Zie trouwens dat de loop overbodig is. (Kan het in het Printout statement regelen)

Dus:
Code:
Sub WbPrintOut()
Dim iStart  As Integer
Dim iEnd    As Integer

 iStart = InputBox("Bij welk blad begin ik")
 iEnd = InputBox("Bij welk blad wil je eindigen")
 
 ThisWorkbook.PrintOut From:=iStart, To:=iEnd
End Sub

See Yah! :thumb:
 
De bedoeling van mijn opgenomen macro is inderdaad om na het gebruik van autofilter een werkblad te printen.
Het is inderdaad mijn bedoeling om na ingave deze macro te laten draaien op bijvoorbeeld werkblad 3 t/m 9.
Nu selecteer ik handmatig elk tabblad (van 3 t/m 9) en voer daarna handmatig de macro uit. Is derhalve erg omslachtig, vooral als ik meer dan 50 keer moet doen !
 
Hai Jan, :D

Zo zou het goed moeten zijn: (niet getest)
Code:
Sub WbPrintOut()
Dim iStart  As Integer
Dim iEnd    As Integer
Dim i       As Integer

 iStart = InputBox("Bij welk blad begin ik")
 iEnd = InputBox("Bij welk blad wil je eindigen")
 
 Application.ScreenUpdating = False
 For i = iStart To iEnd
    With Sheets(i)
        .Unprotect
        .Range("D4:D118").AutoFilter Field:=1, Criteria1:="<>"
        .PrintOut Copies:=1, Collate:=True
        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    End With
 Next i
 Application.ScreenUpdating = True
End Sub

Volgens mij moet het ook mogelijk zijn om alle bladen in één keer te selecteren en dan de printopdracht te geven..heb nu alleen weinig tijd om even te testen..

Succes! :thumb:
 
Ik heb de macro enigszins aangepast.
Ik heb nu nog 2 problemen (uitdagingen).

1. Het Autofilter wordt niet uitgezet
2. Mijn eerste tabblad is nr 1900. Makro werkt alleen als ik bij ingave nummer 1 t/m ... invoer. Bij ingave 1 wordt het eerste blad, zijnde tabblad met naam 1900 afgedrukt.

Hieronder de aangepaste macro :

Sub Printsel2()
Dim iStart As Integer
Dim iEnd As Integer
Dim i As Integer

iStart = InputBox("Bij welk blad begin ik")
iEnd = InputBox("Bij welk blad wil je eindigen")

Set blad = ActiveSheet
Application.ScreenUpdating = False
For i = iStart To iEnd
With Sheets(i)
.Unprotect
.Range("D4:D182").AutoFilter Field:=1, Criteria1:="<>"
.PrintOut Copies:=1, Collate:=True
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
Next i
blad.Select
Application.ScreenUpdating = True
End Sub
 
Hai Jan, :D

Nr 1 is opgelost!
Nr 2 begrijp ik absoluut niet bij mij werkt dit prima dus meer uitleg aub.

Jou aanpassing in de code heb ik verbeterd:
Code:
Sub Printsel2()
Dim iStart As Integer
Dim iEnd As Integer
Dim i As Integer
Dim blad As Excel.Worksheet

iStart = InputBox("Bij welk blad begin ik")
iEnd = InputBox("Bij welk blad wil je eindigen")

Set blad = ActiveSheet
Application.ScreenUpdating = False
For i = iStart To iEnd
With Sheets(i)
.Unprotect
.Range("D4:D182").AutoFilter Field:=1, Criteria1:="<>"
.PrintOut Copies:=1, Collate:=True
.AutoFilterMode = False
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
Next i
blad.Select
Application.ScreenUpdating = True
Set blad = Nothing
End Sub

See Yah! :thumb:
 
Joost, bedankt dat je me wil helpen !

De naam van m'n eerste tabblad is 1900, de volgende 1901, enz.
Als ik in jouw macro als beginblad 1900 invoer en als eindblad 1901 krijg ik de melding "subscript valt buiten bereik".
Als ik echter als beginblad 1 invul en als eindblad 2 worden de tabbladen met de naam 1900 en 1901 (de eerste 2 tabbladen geprint).
 
Hai Jan, :D

Ah nu snap ik wat je bedoeld.

Ja inderdaad ik gebruik de Index van de werkbladen.
Dus dit zijn nummers vanaf blad1 (1) t/m het laatste blad nummer????

Als jij de naam van het blad (1900) in wilt vullen dan wordt de macro volgens mij mega gecompliceerd..

Dus mijn vraag aan jou:
* Kun je niet aan de hand van het index nummer werken?
* Wil je Persé met de namen werken.

Als je dat namelijk echt Persé wilt dan zal ik een poging wagen om het op die manier in te richten.

Dat wordt dan morgen weer dus! :thumb:
 
Ik heb de oplossing gevonden.
Met de volgende aanpassing werkt 't :

iStart = Sheets(InputBox("Bij welk blad begin ik")).Index
iEnd = Sheets(InputBox("Bij welk blad wil je eindigen")).Index

Mega bedankt voor je tijd !!!!!


:thumb: :thumb: :thumb: :thumb: :thumb:
 
Hai Jan, :D

Kijk dat zie ik graag..iemand die zelf door fröbelt tot de oplossing er is! Goed gedaan! :thumb:

Enne you're welcome! :D
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan