Keuze lijst voor aantal prints

Status
Niet open voor verdere reacties.

monty1a

Gebruiker
Lid geworden
29 dec 2006
Berichten
202
Hallo allemaal,

Ik heb een vraag over printen.
Ik heb een knop met de volgende macro:

Code:
Sub Rechthoekafgerondehoeken16_Klikken()
Dim sht1 As Worksheet, sht2 As Worksheet
Dim rng1 As Range, rng2 As Range
    Set sht1 = ActiveSheet
    Set sht2 = Sheets("Werkvergunning")
    sht1.Unprotect
    Set rng1 = Range("C181:L323,C605:L731")
    Sheets("werkvergunning").Visible = True

    With sht2
            .Range("N6").Value = sht1.Range("E57")
            .PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    End With
Sheets("werkvergunning").Visible = False
sht1.Select

End Sub

Alleen bestaat er een mogelijkheid dat ik op Sht1 in j22 het aantal copies neerzet?
Dus als er in J20 van sht1 3 staat dat hij 3x sht2 afdrukt?
Het wil namelijk wel eens verschillen van aantal prints.

A;vast bedankt
 
En dit heb je al eens gedaan?
Code:
Copies:=sht1.Range("J22").Value

Je bent overigens niet duidelijk of het J20 of J22 moet zijn.
 
Laatst bewerkt:
Werkt het zo ook?

Code:
Sub VenA()
  With Sheets("Werkvergunning")
    .Visible = True
    .Range("N6") = Range("E57")
    .PrintOut , , Range("J22").Value
    .Visible = False
  End With
End Sub
 
Laatst bewerkt:
Heb ik een nog een vraagje!

Ik heb een sheet K (1) (deze varieerd van naam)met bepaalde gegevens (putnummers! en kousnummer)
Het aantal prints van de sheet Werkvergunning staat op J23
Het kousnummer komt per print opdracht in Sheet werkvergunning op K6 komt (dit lukt al).

Code:
Sub Knop1_Klikken()
' Afdrukken_water Macro
Dim sht1 As Worksheet, sht2 As Worksheet
Dim rng1 As Range, rng2 As Range
    If MsgBox("U gaat nu de standaardlijsten voor water, installatieplan en toolbox afdrukken!" & vbCr & vbCr _
        & "Wilt u doorgaan?", vbOKCancel + vbQuestion, "Afdrukken") = vbCancel Then Exit Sub
    
    Set sht1 = ActiveSheet
    Set sht2 = Sheets("Werkvergunning")
    Set sht3 = Sheets("UITV_wtr")
    sht1.Unprotect
    Set rng1 = Range("C41:L180,C605:L731")
    Sheets("UITV_wtr").Visible = True
    Sheets("werkvergunning").Visible = True

    With sht1
        rng1.PrintOut Copies:=1, Collate:=True
        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
        With sht2
            .Range("K6").Value = sht1.Range("E57")
            .PrintOut Copies:=sht1.Range("J23").Value, Collate:=True, IgnorePrintAreas:=False
        With sht3
                    .Range("I9").Value = sht1.Range("E57")
            .PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
        End With
    End With
    End With
Sheets("UITV_wtr").Visible = False
Sheets("werkvergunning").Visible = False
sht1.Select

End Sub

Maar wat ik eigenlijk wil is dat hij ook het putnr invult vanuit kolom Y9:Y20 (deze zijn soms niet allemaal ingevuld, maar wel van boven naar beneden)
Deze komt dan op het werkvergunning N6.
Hierbij moet hij dan van elke put (die ingevuld staat) een aparte print maken (x het aantal wat op J23 staat)

Ik hoop dat het te volgen is, voor mij wel, maar om het uit te leggen vind ik vrij lastig.
Ik heb een bijlage toegevoegd om het iets duidelijker te maken.

Alvast bedankt voor het meedenken (helpen).
 

Bijlagen

  • Werkvergunning.xlsm
    21,6 KB · Weergaven: 50
Begin bij het begin. Verbergen, beveiligen msgboxen zijn allemaal poespas die je later nog wel kan toevoegen. Het bestand sluit ook niet echt aan bij de code. Waar komt 'Kousnummer' vandaan?

Heel basaal kom ik tot zoiets
Code:
Sub VenA()
  ar = Sheets("K (1)").Cells(8, 25).CurrentRegion
  x = Sheets("K (1)").Cells(23, 10)
  With Sheets("Werkvergunning")
    For j = 2 To UBound(ar)
      If ar(j, 2) <> "" Then
        .Cells(6, 11).Resize(, 4) = Array(Sheets("K (1)").Cells(9, 10), "Putnummer", , ar(j, 2))
      End If
      .PrintOut , , x
    Next j
  End With
End Sub
 
Sheet K (1) is afwisselend
Dit kan varieeren van K (1) tot K (500)
Kousnummer word weer van een andere sheet vandaan gehaald. Ik heb alleen de hoofdzakelijke bestanden neergezet. Het originele document is ong. 4 mb.

Ik ga zowieso hier ff mee aan de slag om te kijken hoe die code in elkaar zit.

mvg Monty
 
Waarom zet je niet gewoon de 'print & preview' knop in de QAT (snelle toegangsbalk) ?
 
Begin bij het begin. Verbergen, beveiligen msgboxen zijn allemaal poespas die je later nog wel kan toevoegen. Het bestand sluit ook niet echt aan bij de code. Waar komt 'Kousnummer' vandaan?

Heel basaal kom ik tot zoiets
Code:
Sub VenA()
  ar = Sheets("K (1)").Cells(8, 25).CurrentRegion
  x = Sheets("K (1)").Cells(23, 10)
  With Sheets("Werkvergunning")
    For j = 2 To UBound(ar)
      If ar(j, 2) <> "" Then
        .Cells(6, 11).Resize(, 4) = Array(Sheets("K (1)").Cells(9, 10), "Putnummer", , ar(j, 2))
      End If
      .PrintOut , , x
    Next j
  End With
End Sub


Als ik het kousnr invul dan komen er dus een een x aantal putten te staan.
In ieder geval 2, maar dit kan dus oplopen tot 12 putten. Dit is iedere "kous" verschillend.

De code doet eigenlijk prcs wat ik wil, alleen in dit voorbeeld hoort hij dus 4 x 2 werkvergunningen af te drukken, maar hij stopt niet wanneer er lege cellen staan. Nu gooit hij er dus 12 x 2 formulieren uit.

Is het ook mogelijk dat hij de putnrs overneemt van de Active Sheet ipv K (1)?

Alvast bedankt
 
Voor je activesheet:
Code:
ar = Cells(8, 24).CurrentRegion
i.pv.
Code:
ar = Sheets("K (1)").Cells(8, 25).CurrentRegion

Staan er normaal formules in Y9:Y20 en die een spatie " " bevatten i.p.v. leeg "" zijn?
 
Normaal staan er idd formules, die "" als resultaat geven als er niets staat.

Code:
Sub VenA()
  ar = Cells(8, 25).CurrentRegion
  x = Cells(23, 10).CurrentRegion
  With Sheets("Werkvergunning")
    For j = 2 To UBound(ar)
      If ar(j, 2) = "" Then
        .Cells(6, 11).Resize(, 4) = Array(Sheets("K (1)").Cells(9, 10), "Putnummer", , ar(j, 2))
      End If
      .PrintOut , , x
    Next j
  End With
End Sub


Als ik hem nu probeer uit te voeren gaat hij fout bij de PrintOut.
En hoe maakt ik van :
Code:
    .Cells(6, 11).Resize(, 4) = Array(Sheets("K (1)").Cells(9, 10), "Putnummer", , ar(j, 2))
De active sheet?

K (1) veranderd van naam als het om een andere kous gaat. Varieren van K(1) tot K(900)

Thanx
 
Laatst bewerkt:
Dan staat er geen aantal ingevuld in je activeheet.J23

Voor je activesheet.
Code:
.Cells(6, 11).Resize(, 4) = Array(Cells(9, 10), "Putnummer", , ar(j, 2))
 
Bedankt voor je snelle reactie.

Er staat een 1 ingevuld in J23

En gebruikt hij nu dan niet de sheet Werkvergunning?
De knop staat op K (1) , dat is de active sheet, misschien leg ik het niet helemaal goed uit, maar ik doe me best.

mvg Marcel
 
En op die andere 899 bladen heb je ook zo'n knop?

Hij gebruikt blad 'werkvergunning' om naar toe te schrijven door de punt voor cells(6,11).resize(,4).
Plaats eens twee of drie van die bladen zoals je het nu hebt Marcel, anders wordt het een langdurig geschiedenis.
 
Ja klopt, elke "kous" die wij maken krijg een apart tabblad, hieraan zitten nog veel meer gegevens gekoppeld zoals dieptes en lengtes.
Alleen voor elke "kous" en dan zelfs per putnr" moet er ook een aparte vergunning afgedrukt worden.

Bekijk bijlage Werkvergunning.xlsm

Ik hoop dat dit duidelijk is.
 
En moeten alle bladen in een keer achter elkaar geprint worden of wil je gewoon alle bladen bij langs om af te drukken.

Ik mis nog de formules in kolom Y, zodat ik zeker weet dat het goed zit.
 
Zo moet het toch kloppen volgens mij.
Code:
Sub Knop1_Klikken()
' Afdrukken_water Macro
If MsgBox("U gaat nu de standaardlijsten voor water, installatieplan en toolbox afdrukken!" & vbCr & vbCr _
        & "Wilt u doorgaan?", vbOKCancel + vbQuestion, "Afdrukken") = vbCancel Then Exit Sub
ar = Cells(8, 24).CurrentRegion
x = Cells(23, 10)
    If x > 0 Then
        With Sheets("Werkvergunning")
          For j = 2 To UBound(ar)
            If ar(j, 2) <> "" Then
              .Cells(6, 11).Resize(, 4) = Array(Cells(9, 10), "Putnummer", , ar(j, 2))
              .PrintOut , , x
            End If
          Next j
        End With
 End If
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan