Krijg loop niet werkend

[erpee]

De onderstaande code maakt gebruik van de sheets "Schapkaart" en "Schapkaart_print" en moet het volgende doen:

1. De te printen data wordt in de Sheet geladen.
2. Er wordt een print opdracht gegeven voor sheet "Schapkaart_Print" (In deze sheet wordt de data geladen in een format met 21 schapkaarten)
3. De reeds geprinte 21 rijen worden verwijderd.

4. De stappen 2 en 3 moeten herhaald worden totdat Sheet"Schapkaart" in cel A1 geen waarde meer heeft staan

1 t/m 3 werk maar 4 lukt me niet (Ik heb ook onvoldoende kennis van het loopen van een code, is dus een knip en plakwerkje van gevonden codes)

Sub PrintSchapkaart()

'Module voor schapkaart printen

'verzamelen van aanwezige data

    Sheets("ProductData").Select
    Range("A2:C300").Select
    Selection.Copy
    Sheets("Schapkaart").Select
    Range("A1").Select
    ActiveSheet.Paste

'printen via "Schapkaart_Print sheet"

Do
    Sheets("Schapkaart_Print").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    Sheets("Schapkaart").Select

    '21 rijen verwijderen uit "Schapkaart" sheet
    Rows("1:21").Select
    Selection.Delete Shift:=xlUp
    
    'Loop totdat data leeg is

Loop Until IsEmpty(Schapkaart.Range("A1")) = True

MsgBox "Schapkaarten printen is voltooid.", vbOKOnly, "Printbevestiging"

End Sub

 

[edmoor]

Plaats een voorbeeld document.

 

[AHulpje]

Hoe wordt Schapkaart_print gevuld?
Als dat met verwijzingen naar Schapkaart gaat dan ben je die na

        Selection.Delete Shift:=xlUp

kwijt. Daar zul je dus een stukje code voor moeten gebruiken.

Sub PrintSchapkaart()
    'Module voor schapkaart printen
    'verzamelen van aanwezige data
    Sheets("ProductData").Range("A2:C300").Copy Sheets("Schapkaart").Range("A1")
    'printen via "Schapkaart_Print sheet"
    Do
        Sheets("Schapkaart_Print").Select
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
        Sheets("Schapkaart").Select
        '21 rijen verwijderen uit "Schapkaart" sheet
        Rows("1:21").Select
        Selection.Delete Shift:=xlUp
        'Loop totdat data leeg is
    Loop Until Sheets("Schapkaart").Range("A1") = vbNullString
    MsgBox "Schapkaarten printen is voltooid.", vbOKOnly, "Printbevestiging"
End Sub

 

[erpee]

Klopt, dat ik die verwijzingen dan kwijt ben, merkte ik net ook
nog even terug naar de tekentafel.

Ik zal een voorbeeld posten maar moet 'm eerst wat "uitkleden", vanwege aanwezige bedrijfsdata

 

[HSV]

Blad "schapkaart" heb je in principe niet nodig.

Om papier en inkt te besparen staan er drie komma's en True achter .PrintOut; haal ze weg om echt te printen.

Sub hsv()
Dim i As Long
For i = 2 To Sheets("productdata").Cells(Rows.Count, 1).End(xlUp).Row Step 21
 With Sheets("schapkaart_print").Cells(1).Resize(21, 3)
  .Value = Sheets("productdata").Cells(i, 1).Resize(21, 3).Value
  .PrintOut , , , True
  .ClearContents
 End With
 Next i
End Sub

 

[erpee]

Dank alvast voor de input. :thumb:
Ik ga er morgen mee verder. Heb nu geen tijd meer.

 

[AHulpje]

Zelf nog even VulSchapkaartPrint aanpassen:

Option Explicit

Sub PrintSchapkaart()
    Dim r As Integer
    For r = 2 To Sheets("ProductData").Cells(Rows.Count, 1).End(xlUp).Row Step 21
        VulSchapkaartPrint (r)
        Sheets("Schapkaart_Print").PrintOut
    Next
End Sub


Function VulSchapkaartPrint(rij)
    Dim r As Integer
    Dim k As Integer
    With Sheets("Schapkaart_Print")
        'Even wat willekeurige data kopieren
        For r = 1 To 21
            For k = 1 To 3
                .Cells(r, k) = Sheets("ProductData").Cells(r - 1 + rij, k)
            Next
        Next
    End With
End Function

 

[snb]

- Gebruik de eigenschappen van Excel
- reduceer interaktie met een werkblad
- vermijd overbodige variabelen
- gebruik waar mogelijk arrays

Sub M_snb()
  sn-Sheets("ProductData").cells(1).currentregion

  For j = 2 To ubound(sn) Step 21
    with sheets("Schapkaart_Print")
      .cells(1).resize(5,20)=application.index(sn, evaluate("row(" & j & ":" & j+20 &")"),array(1,2,3,4,5))        VulSchapkaartPrint (r)
      .PrintOut
    end with
  Next
End Sub

 

[erpee]

Toch dit project weer opgepakt.
Als bijlage een voorbeeld van het bestand. Alle aanwezige data is fictief
Ik krijg dus het bovenstaande nog niet voor elkaar. Gooi het maar op het waarderen van de input maar het niet snappen hoe te implementeren.
Wellicht dat iemand dit wel voor elkaar krijgt. (I Hope....)

 

[AHulpje]

Het kan allemaal ietsje pietsje simpeler, werkblad Schapkaart is ook niet meer nodig.
Vervang de inhoud van Module3 door:

Option Explicit

Sub PrintSchapkaart()
    Dim rijProductdata As Integer
    rijProductdata = 2
    Do While Sheets("ProductData").Cells(rijProductdata, 1) <> vbNullString
        Laaddata (rijProductdata)
        Sheets("Schapkaart_Print").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
        Sheets("Schapkaart_Print").Cells.ClearContents
        rijProductdata = rijProductdata + 21
    Loop
    MsgBox "Schapkaarten printen is voltooid.", vbOKOnly, "Printbevestiging"
End Sub


Sub Laaddata(rijProductdata)
    Dim rij As Integer
    Dim kol As Integer
    Dim rijSchapkaart As Integer
    rij = 2
    kol = 2
    rijSchapkaart = rijProductdata
    With Sheets("ProductData")
        For rijSchapkaart = rijProductdata To rijProductdata + 20
            Sheets("Schapkaart_Print").Cells(rij, kol) = .Cells(rijSchapkaart, 3)
            Sheets("Schapkaart_Print").Cells(rij + 1, kol) = .Cells(rijSchapkaart, 4)
            Sheets("Schapkaart_Print").Cells(rij + 2, kol) = .Cells(rijSchapkaart, 2)
            kol = kol + 2
            If kol > 6 Then
                kol = 2
                rij = rij + 4
            End If
        Next
    End With
End Sub

 

[snb]

Heb je überhaupt iets gedaan ( laten uitvoeren bijv.)
Dit is absoluut voldoende:

Sub M_snb()
  with Sheets("ProductData")
     For j = 2 To .usedrange.rows.count Step 21
       .cells(j,1).resize(20,5).PrintOut
    next
  End With
End Sub

 

[AHulpje]

@snb
Weet je zeker dat jouw oplossing "absoluut voldoende" is?
Werkt bij mij voor geen meter nadat ik de syntaxfout heb verbeterd:

[COLOR=#3E3E3E].usedrange.rows[/COLOR]

[COLOR=#3E3E3E].usedrange.rows.count[/COLOR]

 

[erpee]

Dank jullie wel. Heb het nu draaiend en heel blij mee!

snb: Heb je überhaupt iets gedaan ( laten uitvoeren bijv.)

Ja, geprobeerd maar zoals ik al aangaf:

Ik krijg dus het bovenstaande nog niet voor elkaar. Gooi het maar op het waarderen van de input maar het niet snappen hoe te implementeren.

 

[snb]

@Ahul

Met de .count toevoeging loopt het hier als een zonnetje.
Wellicht een .Select toevoegen om het geselecteerde gebied te zien en met F8 te checken ?

Een afzonderlljk printblad is overbodig.
Vertel eens in detail wat er mis gaat

 

[AHulpje]

@snb
Zie plaatje, bovenaan jouw layout, onderaan de gewenste layout.

 

[snb]

Je hebt in dit geval slechts 1 regel VBA nodig.
Het etiketprintblad moest eerst wel even ontdaan worden van 50 overbodige, identieke afbeeldingen.
Alle voor de vraag overbodige werkbladen verwijderd.
Overbodige kolom D in schapkaart verwijderd.

Verander de waarde in cel I2 in het printblad,