• 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.

2 macro's naar 1

Status
Niet open voor verdere reacties.

verluc

Gebruiker
Lid geworden
29 mei 2009
Berichten
535
Hieronder twee identieke macro's voor het printen.
Het enige verschil is dat de Range/Kolommen verschillend is.
Ik vraag me af of dit niet in één macro kan worden verwerkt, kwestie van eenvoud.
Met oprechte dank voor elke aanzet tot verkorting.

Sub druk1() ' Volledig
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim lastCell As Long
lastCell = Range("A" & Rows.Count).End(xlUp).Row
Columns("O:R").EntireColumn.Hidden = True
ActiveSheet.PageSetup.RightFooter = "Gedrukt &D"
ActiveSheet.PageSetup.CenterFooter = "Pagina &P - &N"
ActiveSheet.PageSetup.LeftFooter = "Blad1"
ActiveSheet.PageSetup.PrintArea = "A1:N" & lastCell
ActiveSheet.Range("A4:R1000").Interior.ColorIndex = 0
If Application.Dialogs(xlDialogPrinterSetup).Show Then
ActiveSheet.PrintOut
Columns("O:R").EntireColumn.Hidden = False
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
______________________________________
Sub druk() ' Beperkt
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim lastCell As Long
lastCell = Range("A" & Rows.Count).End(xlUp).Row
Range("E:E,G:G,I:I,K:L,N:N").EntireColumn.Hidden = True
ActiveSheet.PageSetup.RightFooter = "Gedrukt &D"
ActiveSheet.PageSetup.CenterFooter = "Pagina &P - &N"
ActiveSheet.PageSetup.LeftFooter = "Blad1"
ActiveSheet.PageSetup.PrintArea = "A1:R" & lastCell
ActiveSheet.Range("A4:R1000").Interior.ColorIndex = 0
If Application.Dialogs(xlDialogPrinterSetup).Show Then
ActiveSheet.PrintOut
Range("E:E,G:G,I:I,K:L,N:N").EntireColumn.Hidden = False
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub
 
Als geregistreerde sinds 2009 zou je toch moeten weten dat je code in code tags hoort te plaatsen.

De macro's doen beide hetzelde, alleen op verschillende ranges. Dat is best samen te voegen, maar afhankelijk waarvan moet dan de ene danwel de andere range worden gebruikt?
 
Beste Edmoor,

Weet inderdaad dat een macro in TAGS dient geplaatst te worden, doch kon op het invoerscherm niet direct deze aanwijzing vinden.
(vroeger kon dit met # te plaatsen aan het begin en einde van de macro)
Keuze van drukwerk is : Optionbutton7 voor volledig en Optionbutton8 voor beperkt.
 
Dat kan nog steeds als je naar Geavanceerd gaat. Ook kun je de code omsluiten met [ CODE] en [ /CODE], maar dan zonder de spaties achter het [ teken.

Probeer deze eens aan beide OptionButtons:
Code:
Sub Druk_Click()
    Dim LastRow As Long
    Dim Volledig As Boolean
    
    If Application.Caller = "OptionButton7" Then Volledig = True
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    
    If Volledig Then
        Columns("O:R").EntireColumn.Hidden = True
    Else
        Range("E:E,G:G,I:I,K:L,N:N").EntireColumn.Hidden = True
    End If
    
    With ActiveSheet
        .pagetsetup.RightFooter = "Gedrukt &D"
        .pagetsetup.CenterFooter = "Pagina &P - &N"
        .pagetsetup.LeftFooter = "Blad1"
        If Volledig Then
            .pagetsetup.PrintArea = "A1:N" & LastRow
        Else
            .PageSetup.PrintArea = "A1:R" & LastRow
        End If
        .Range("A4:R1000").Interior.ColorIndex = 0
    End With
    
    If Application.Dialogs(xlDialogPrinterSetup).Show Then
        ActiveSheet.PrintOut
        If Volledig Then
            Columns("O:R").EntireColumn.Hidden = False
        Else
            Range("E:E,G:G,I:I,K:L,N:N").EntireColumn.Hidden = False
        End If
    End If
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 
Laatst bewerkt:
Zeer bedankt Edmoor, werkt zoals verwacht en met een kortere macro, hetgeen ik ten zeerste op prijs stel.
Zet vraag als "opgelost" !!
 
Ok dan. En je hebt ook gezien hoe dat bewerkstelligd is? Da's ook belangrijk natuurlijk :)
 
of
Code:
Sub Druk_Click()
    b00 = Application.Caller = "OptionButton7"
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    
        With ActiveSheet
            .Columns("O:R").EntireColumn.Hidden = b00
            .Range("E:E,G:G,I:I,K:L,N:N").EntireColumn.Hidden = Not b00
            with .pagesetup
                .RightFooter = "Gedrukt &D"
                .CenterFooter = "Pagina &P - &N"
                .LeftFooter = "Blad1"
             end with
            .Range("A4:R1000").Interior.ColorIndex = 0
            .PrintOut
            .Columns.Hidden = False
        End With
      
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
 
Laatst bewerkt:
Sorry SNB , krijg een foutmelding op de volgende lijn :

.PrintArea = Cells(1).CurrentRegion.Resize(, 14 + 4 * Abs(Not b00)).Address

Enig idee ?
 
Als je zegt een foutmelding te krijgen is het ook handig deze er dan even bij te vermelden.
 
Beste Edmoor en SNB,

Foutmelding is intussen opgelost.
Was mijn eigen fout door te vlug een aanpassing te doen aan deze regel.
Werkt thans perfect waarvoor mijn groot respect !
 
Je kunt die regel volgens mij ook weglaten, omdat de kolommen toch al verborgen zijn. (het is een beetje dubbelop).
 
SNB,

Heb volgende aangepaste macro:

Sub drukken()
b00 = Application.Caller = "OptionButton7"
With Application
.EnableEvents = False
.ScreenUpdating = False
With ActiveSheet
.Columns("O:R").EntireColumn.Hidden = b00
.Range("E:E,G:G,I:I,K:L,N:N").EntireColumn.Hidden = Not b00
.Range("A4:R1000").Interior.ColorIndex = 0
.PrintOut
.Columns.Hidden = False
End With
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

Ik stel echter vast dat er steeds afgedrukt word op basis van "Optionbutton7"
Bij keuze van "Optionbutton8" is het drukwerk steeds op basis van "Optionbutton7"
Blijkbaar onderscheid deze macro niet tussen 7 en 8

N.B. Edmoor, waar vind ik de knop "geavanceerd"
 
Sub drukken()
b00 = Application.Caller = "OptionButton7"
With Application
.EnableEvents = False
.ScreenUpdating = False
With ActiveSheet
.Columns("O:R").EntireColumn.Hidden = b00
.Range("E:E,G:G,I:I,K:L,N:N").EntireColumn.Hidden = Not b00
.Range("A4:R1000").Interior.ColorIndex = 0
.PrintOut
.Columns.Hidden = False
End With
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
 
Lees de eerste regel van #4 nog eens door en pas svp de laatste 2 berichten aan.
 
Code:
Sub drukken()
 b00 = Application.Caller = "OptionButton7"
          With Application
                .EnableEvents = False
                .ScreenUpdating = False
          With ActiveSheet
                .Columns("O:R").EntireColumn.Hidden = b00
                .Range("E:E,G:G,I:I,K:L,N:N").EntireColumn.Hidden = Not b00
                .Range("A4:R1000").Interior.ColorIndex = 0
                .PrintOut
                .Columns.Hidden = False
           End With
               .EnableEvents = True
               .ScreenUpdating = True
 End With
 End Sub
 
Heb je de namen van de knoppen gecontroleerd ?
 
Edmoor, U hebt misschien een punt.
Thans moet ik de keuze maken in mijn formulier tussen : Optionbutton7 of Optionbutton8
Eens die keuze gemaakt dient nogmaals een "Startknop" = Optionbuton2 gedrukt om
het drukwerk te starten, dit om de mogelijkheid te hebben nog 7 of 8 te kunnen wijzigen
indien verkeerde keuze zou gemaakt zijn.
Zit hierin misschien een fout dat de macro niet correct werkt?
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan