• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Print macro

Status
Niet open voor verdere reacties.
R

RobYol

Gebruiker
Lid geworden
3 nov 2009
Berichten
63
Sub printblad()
ActiveSheet.Unprotect 'Password="blabla"
Application.ScreenUpdating = False
Dim r As Range
For Each r In Range("A8:A47")
If r.Value <= "" Then
r.EntireRow.Hidden = True
Else
r.EntireRow.Hidden = False
End If
Next
With ActiveSheet.PageSetup
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Range("A1:AE47").PrintOut copies:=1
Rows("1:47").EntireRow.Hidden = False
Application.ScreenUpdating = True
ActiveSheet.Protect 'Password="blabla"
End Sub
Klik om te vergroten...

Gebruik deze macro voor het printen van diverse werkbladen. Op werkblad 1 doet hij het netjes printen op 1 A4. Omdat de printerinstellingen staat op aanpassen aan 1 bij 1 pagina(s). Op werkblad 2 staat dit niet ingesteld en print hij het NIET op 1 A4. Hoe moet dit in de macro worden aangepast zodat dit wel goed gaat en ik niet bij alle 50 werkbladen dit moet wijzigen.

Daarnaast moet ik ook de marges op minimaal zetten ver elk werkblad. Hoe doe ik dit in deze macro.

Gr Robert.
 
Laatst bewerkt:
je gebruikt
Code: 
[B]With ActiveSheet.PageSetup[/B]
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.FitToPagesWide = 1
.FitToPagesTall = 1
End With

Kun je hier geen For each... gebruiken?
 
sickofitall zei:
je gebruikt
Code: 
[B]With ActiveSheet.PageSetup[/B]
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.FitToPagesWide = 1
.FitToPagesTall = 1
End With

Kun je hier geen For each... gebruiken?
Klik om te vergroten...

Nee dat pakt hij niet bij mij.
 
Code: 
Sub printblad()
    Dim cl As Range
    Application.ScreenUpdating = False
    With ActiveSheet
        .Unprotect 'Password="blabla"
        For Each cl In .[A8:A47]
            cl.EntireRow.Hidden = IIf(cl.Value = "", True, False)
        Next
        With .PageSetup
            .PrintArea = [A1:AE47]
            .CenterHorizontally = True
            .CenterVertically = False
            .Orientation = xlLandscape
            .FitToPagesWide = 1
            .FitToPagesTall = 1
        End With
        .PrintOut , , 1
        .Rows("1:47").EntireRow.Hidden = False
        .Protect 'Password="blabla"
    End With
    Application.ScreenUpdating = True
End Sub
 
Warme bakkertje zei:
Code: 
Sub printblad()
    Dim cl As Range
    Application.ScreenUpdating = False
    With ActiveSheet
        .Unprotect 'Password="blabla"
        For Each cl In .[A8:A47]
            cl.EntireRow.Hidden = IIf(cl.Value = "", True, False)
        Next
        With .PageSetup
            .PrintArea = [A1:AE47]
            .CenterHorizontally = True
            .CenterVertically = False
            .Orientation = xlLandscape
            .FitToPagesWide = 1
            .FitToPagesTall = 1
        End With
        .PrintOut , , 1
        .Rows("1:47").EntireRow.Hidden = False
        .Protect 'Password="blabla"
    End With
    Application.ScreenUpdating = True
End Sub
Klik om te vergroten...

Krijg foutmelding 1004:

Eigenschap PrintArea van klasse PageSetup kan niet worden ingesteld.

? Waar ligt dit aan ?
Gr Robert
 
Code: 
.PrintArea = "$A$1:$AE$47"
 
Betse RobYol ;)

Hoe worden ze afgeprint ?

Staat alles onder elkaar of naast elkaar.
Indien naast elkaar probeer dan :

Code: 
.CenterVertically = True

Groetjes Danny. :thumb:
 
danny147 zei:
Betse RobYol ;)

Hoe worden ze afgeprint ?

Staat alles onder elkaar of naast elkaar.
Indien naast elkaar probeer dan :

Code: 
.CenterVertically = True

Groetjes Danny. :thumb:
Klik om te vergroten...

Ieder week is een werkblad en bevat een rooster met het bereik A1:AE47 dit rooster moet liggend worden afgedrukt op 1 A4.

Heb bovenstaand geprobeerd maar lukt niet?
 
Beste RobYol ;)

En met deze code.

Code: 
         Sub printblad()
         Dim cl As Range
         Application.ScreenUpdating = False
         With ActiveSheet
         .Unprotect 'Password="blabla"
         For Each cl In .[A8:A47]
         cl.EntireRow.Hidden = IIf(cl.Value = "", True, False)
         Next
         With .PageSetup
        .PrintArea = [A1:AE47]
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        End With
        .PrintOut , , 1
        .Rows("1:47").EntireRow.Hidden = False
        .Protect 'Password="blabla"
        End With
        Application.ScreenUpdating = True
        End Sub

Groetjes Danny. :thumb:
 
danny147 zei:
Beste RobYol ;)

En met deze code.

Code: 
         Sub printblad()
         Dim cl As Range
         Application.ScreenUpdating = False
         With ActiveSheet
         .Unprotect 'Password="blabla"
         For Each cl In .[A8:A47]
         cl.EntireRow.Hidden = IIf(cl.Value = "", True, False)
         Next
         With .PageSetup
        .PrintArea = [A1:AE47]
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        End With
        .PrintOut , , 1
        .Rows("1:47").EntireRow.Hidden = False
        .Protect 'Password="blabla"
        End With
        Application.ScreenUpdating = True
        End Sub

Groetjes Danny. :thumb:
Klik om te vergroten...

Top danny met wat kleine aanpassingen doet hij het suppppperrrrrrrrrrrrrr.

:thumb:
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan