Auteur Topic: vba for..next..-loop wegschrijfvraagje (gelezen 9937 keer)

BlackDevil · « **Reactie #15 Gepost op:** 13 januari 2024, 14:59:24 »

*update*

Om in het verdere verloop potentiële misverstanden/problemen, mbt gebruikte bestands-versie, te voorkomen voeg ik alvast een nieuwe
en meest recente versie toe van het bestand (v2.0).

Gezien een licht gewijzigde bestandsopbouw heb ik, om latere verwarring te voorkomen, enkele benamingen gewijzigd (subnaam en knop-namen)
naar een meer relevante benaming. De sub (achter mod_preconversie) is in principe nu volledig afgewerkt (alle uitgevoerde testen succesvol).

groetjes,
Bieke

BlackDevil · « **Reactie #16 Gepost op:** 13 januari 2024, 18:04:12 »

*update* (again

)

Ondertussen reeds goed gevorderd in de codering voor de aanmaak van de 'totaal-db'

...

De algemene code alsook de code voor het gedeelte "IDX_G" is volledig af (voorlopig).
Ik moet nu enkel nog voor "IDX_H" en "IDX_O" de code schrijven maar wou toch al delen wat
ik tot dusver heb (ben er best wel trots op... al zeg ik het zelf

).

In bijlage dus eventjes versie 2.0b

(en nu even eerst voor het avondeten zorgen

)

groetjes,
Bieke

BlackDevil · « **Reactie #17 Gepost op:** 14 januari 2024, 15:41:38 »

Goede namiddag allemaal,

Vanochtend heb ik de code voor de 'totaal_db' succesvol in zijn totaliteit afgewerkt en ben dan deze middag gestart met de procedures voor de statistieken te coderen.
Het bestand heeft betrekking op mijn gemeente (als hulpmiddel voor mijn boek dat ik aan het schrijven ben voor de plaatselijke heemkring) en telt in totaal 5 parochies.
De eerste procedure voor 'stats/jaar/parochie' ging vrij vlotjes en heb ik als volgt opgebouwd :

Code: [Selecteer]

Sub statspar()
  Application.ScreenUpdating = False
  Dim par(), jaren As Long, k(), j As Long, statsjaar As Variant, i As Long, telgpar(0 To 4), telhpar(0 To 4), telopar(0 To 4)
  With Sheets("STATS-par")
    Range("q3:s350").ClearContents
    par = Array(.Cells(1, 2), .Cells(1, 5), .Cells(1, 8), .Cells(1, 11), .Cells(1, 14))
    jaren = .Cells(Rows.Count, 1).End(xlUp).Row
    k = Array(2, 5, 8, 11, 14)
    For j = 3 To jaren
      statsjaar = .Cells(j, 1)
      For i = 0 To 4
        telgpar(i) = WorksheetFunction.CountIfs(Sheets("IDX_G").Range("A2:A100000"), par(i), Sheets("IDX_G").Range("D2:D100000"), statsjaar)
        telhpar(i) = WorksheetFunction.CountIfs(Sheets("IDX_H").Range("A2:A100000"), par(i), Sheets("IDX_H").Range("D2:D100000"), statsjaar)
        telopar(i) = WorksheetFunction.CountIfs(Sheets("IDX_O").Range("A2:A100000"), par(i), Sheets("IDX_O").Range("D2:D100000"), statsjaar)
      Next i
      For i = 0 To 4
        .Cells(j, k(i)) = telgpar(i)
        .Cells(j, 17) = .Cells(j, 17) + telgpar(i)
        .Cells(j, k(i) + 1) = telhpar(i)
        .Cells(j, 18) = .Cells(j, 18) + telhpar(i)
        .Cells(j, k(i) + 2) = telopar(i)
        .Cells(j, 19) = .Cells(j, 19) + telopar(i)
      Next i
    Next j
  End With
End Sub

De tweede procedure voor 'stats/familienaam/parochie' echter is een pak ingewikkelder omwille van de diverse schrijfwijzes en de wijze waarop ik achteraf deze statistieken zal nodig hebben.
Ik heb dus per parochie het absolute totaal nodig van elke stamnaam (geconverteerde vorm) maar daarnaast heb ik ook de totalen nodig van de onderverdeling per schrijfwijze van de naam (vorm zoals in de akten vermeld).
En dit dus telkens voor zowel de geboorten, huwelijken als overlijdens.
En daar zit ik dus een beetje vast over de juiste aanpak in zijn geheel (dus zowel qua indeling van mijn werkblad als qua structuur van de code).

Ik moet dus op de "IDX"-werkbladen per soort (G/H/O) het aantal x tellen dat elke vermelde naam voorkomt per parochie en voor elke unieke vermelding dan enerzijds het aantal wegschrijven maar anderzijds dan ook de stamnaam opzoeken (in het "famnm-conv"-werkblad) en vermelden.
Echter moet nu ook wel rekening gehouden worden met de namen die reeds vermeld zijn op de stats-pagina zodat elke naam-vorm (schrijfwijze zoals in de akte) maar 1x voorkomt met daarachter de aantallen van zowel geboorten, huwelijken als overlijdens op één rij. Dus enkel de stamnamen mogen meermaals voorkomen.
Ik zal dan vermoedelijk voor het absolute totaal per stamnaam een aparte pagina dienen aan te maken voor de verwerking in mijn boek.

En ik realiseer me nu net dat ik met deze uitleg al een persoonlijke brainstorm-sessie heb uitgevoerd dus ik ga alvast eerst eens bekijken of ik er toch niet zelf uit geraak
en anders schakel ik hier de hulplijn alsnog in met een recente versie van mijn bestand

.

groetjes,
Bieke

BlackDevil · « **Reactie #18 Gepost op:** 14 januari 2024, 18:25:06 »

wordt hier stilaan een gezellig monoloogje

het 2e deel van de stats ging vlotter dan verwacht dus hiermee is het onderdeel 'statistieken' ook afgerond.

nu resten mij nog enkel de onderdelen 'tafels', 'gedigitaliseerde akten', "gezinnen" en "families" .... nog wel eventjes mijn bezigheid mee dus

.
En dan uiteindelijk nog het 'uitvoer' gedeelte voor de publicatie maar dat is voor een later stadium

.

Vermoedelijk zal ik zo nu en dan nog wel eens een hulplijn nodig hebben dus jullie lezen me hier nog wel

groetjes,
Bieke

BlackDevil · « **Reactie #19 Gepost op:** 15 januari 2024, 17:37:16 »

hier ben ik nog eens

...

Het is niet perse een groot probleem want de code op zich zou in principe wel moeten werken (heb ze nog niet getest) maar het is eerder de
opbouw van een codeblokje met tal van voorwaarden waar ik niet meteen blij van wordt (mbt omvang)

...
Ik heb het opgebouwd als een select case met daarin geneste if-statements als volgt :

Code: [Selecteer]

     Select Case .Cells(i, 20)
        Case "kind"
          If .Cells(i, 11) <> "" Then
            If (.Cells(i, 12) & " " & .Cells(i, 13)) <> " " Then
              bs = "kind van " & .Cells(i, 11) & " & " & .Cells(i, 12) & " " & .Cells(i, 13)
            Else
              bs = "kind van " & .Cells(i, 11)
            End If
          Else
            bs = .Cells(i, 20)
          End If
        Case "ong"
          bs = "ongehuwd"
        Case "geh"
          If (.Cells(i, 18) & " " & .Cells(i, 19)) = " " Then
            If (.Cells(i, 16) & " " & .Cells(i, 17)) = " " Then
              If (.Cells(i, 14) & " " & .Cells(i, 15)) = " " Then
                bs = "gehuwd"
              Else
                bs = "echtg. van " & .Cells(i, 14) & " " & .Cells(i, 15)
              End If
            Else
              bs = "echtg. van " & .Cells(i, 16) & " " & .Cells(i, 17)
            End If
          Else
            bs = "echtg. van " & .Cells(i, 18) & " " & .Cells(i, 19)
          End If
        Case "wed"
          If (.Cells(i, 18) & " " & .Cells(i, 19)) = " " Then
            If (.Cells(i, 16) & " " & .Cells(i, 17)) = " " Then
              If (.Cells(i, 14) & " " & .Cells(i, 15)) = " " Then
                If .Cells(i, 8) = "m" Then bs = "weduwnaar"
                If .Cells(i, 8) = "v" Then bs = "weduwe"
              Else
                bs = "wed. van " & .Cells(i, 14) & " " & .Cells(i, 15)
              End If
            Else
              bs = "wed. van " & .Cells(i, 16) & " " & .Cells(i, 17)
            End If
          Else
            bs = "wed. van " & .Cells(i, 18) & " " & .Cells(i, 19)
          End If
      End Select

Naar mijn gevoel kan de opbouw van de vermelde voorwaarden mogelijks wat efficiënter (en hopelijk misschien wat korter

).

Dus als iemand zich geroepen voelt om de structuur van de voorwaarden te verbeteren dan zou dat zeer fijn zijn

.
Alvast dank op voorhand.

groetjes,
Bieke

BlackDevil · « **Reactie #20 Gepost op:** 16 januari 2024, 16:04:51 »

Goedenamiddag allemaal,

De vraagstelling uit mijn vorig bericht (#19) is niet langer relevant gezien ik er zelf in geslaagd ben het betreffende codeblok in te korten.
Het onderdeel 'tafels' heb ik dan ook gisteren volledig afgewerkt gekregen.

Vandaag ben ik dan aan het onderdeel "digitale akten" begonnen en in principe is dit ook grotendeels reeds in orde (voor de dopen toch al)
maar ik zou graag een klein extraatje hebben waarvan ik niet goed weet hoe ik dit in mijn reeds bestaande code kan verwerken.

Dus enerzijds heb ik mijn werkblad met de geïndexeerde akten (in het bijgevoegde bestand "data" genoemd) en anderzijds heb ik dan het
werkblad "DIG_G_PR" om de geïndexeerde akten te 'digitaliseren'. De lay-out van het werkblad ""DIF_G_PR" is voor 95% via VBA-code uitgevoerd.
De code hiervoor is volledig in orde, daar dient niets in gewijzigd te worden.

De code die wel aangepast moet worden is de sub "dataprint".
Nu schrijft de code via een loop netjes de benodigde gegevens van alle gevulde rijen uit werkblad "data" achtereenvolgens, ongeacht het jaartal, op de correcte wijze weg
(na 10 aktes opschuiven naar de volgende pagina).

Wat ik nu graag zou verwezenlijken is dat hij enerzijds, van zodra een nieuw jaartal begonnen wordt, ook een nieuwe pagina begonnen wordt en anderzijds dat hij bovenaan elke pagina (in de cel waar momenteel het woord "jaar" staat) het jaartal van de vermelde aktes wegschrijft.

stel, er zijn 28 aktes waarvan 15 aktes in 1620 en 13 aktes in 1621 dan moet dit als volgt weggeschreven worden :
pagina 1 (kolom 2 in het werkblad) akte 1 tem 10 met bovenaan het jaartal '1620'
pagina 2 (kolom 6 in het werkblad) akte 11 tem 15 met bovenaan het jaartal '1620'
pagina 3 (kolom 10 in het werkblad) akte 16 tem 25 met bovenaan het jaartal '1621'
pagina 4 (kolom 14 in het werkblad) akte 26 tem 28 met bovenaan het jaartal '1621'

In bijlage een testbestandje waarmee bovenstaande uitleg hopelijk duidelijker zal worden

.

Alvast dank op voorhand.
groetjes,
Bieke

BlackDevil · « **Reactie #21 Gepost op:** 17 januari 2024, 13:01:51 »

***update***

Uiteraard ben ik zelf ook blijven zoeken en het heeft me eventjes wat denk-, puzzel- en vooral testwerk gekost en waarschijnlijk zal er een betere manier bestaan maar heb het zelf voorlopig als volgt opgelost :

Code: [Selecteer]

Sub dataprint()

 With Sheets("data")
   For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
      jaar = .Cells(i, 4)                           'toegevoegd
      jaar2 = .Cells(i - 1, 4)                      'toegevoegd
      If i = 2 Then jaar2 = jaar                    'toegevoegd
      datum = .Cells(i, 2) & "-" & .Cells(i, 3) & "-" & .Cells(i, 4)
      dopeling = .Cells(i, 9) & " " & .Cells(i, 10)
      If .Cells(i, 8) = "m" Then gslcht = "fs. "
      If .Cells(i, 8) = "v" Then gslcht = "fa. "
      ouders = gslcht & .Cells(i, 11) & " " & .Cells(i, 12) & " & " & .Cells(i, 13)
      If .Cells(i, 11) = "onwettig" Then ouders = gslcht & .Cells(i, 12) & " " & .Cells(i, 13)
      doopgetuigen = .Cells(i, 14) & " " & .Cells(i, 15) & " & " & .Cells(i, 16) & " " & .Cells(i, 17)
         
      If jaar = jaar2 Then If j = 60 Then j = 0: jj = jj + 4    'aangepast
      If jaar > jaar2 Then j = 0: jj = jj + 4                   'toegevoegd
      Sheets("DIG_G_PR").Cells(j + 6, jj + 2).Resize(4) = Application.Transpose(Array(datum, dopeling, ouders, doopgetuigen))
      j = j + 6
   Next
 End With
 With Sheets("DIG_G_PR")                            'toegevoegd
  For i = 1 To 100 Step 4                           'toegevoegd
      If .Cells(6, i + 1) <> "" Then                'toegevoegd
        .Cells(3, i) = Right(.Cells(6, i + 1), 4)   'toegevoegd
      End If                                        'toegevoegd
    Next i                                          'toegevoegd
 End With                                           'toegevoegd
End Sub

de lijntjes code die ik heb toegevoegd of aangepast heb ik voorzien van de commentaar 'toegevoegd' of 'aangepast'

groetjes,
Bieke

MollyVH · « **Reactie #22 Gepost op:** 17 januari 2024, 15:59:26 »

Hey Bieke,

'k Ben er (overmacht

) weer even niet geweest. Fijn dat je het ondertussen zelf hebt opgelost, maar omwille van jouw

Citaat

en waarschijnlijk zal er een betere manier bestaan

hierbij een stukje code dat zich (momenteel, en mogelijk blijvend, nog beperkt tot mijn eigen aanvoelen

) iets beter laat lezen.
Het gedeelte vanaf "datum =" t/m "doopgetuigen =" is identiek gebleven.

Code: [Selecteer]

Sub dataprint()

kolom = -2
rij = 6
With Sheets("data")
  For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
    jaar = .Cells(i, 4)
    If jaar <> vorig Or rij > 60 Then
      kolom = kolom + 4
      rij = 6
      Sheets("DIG_G_PR").Cells(3, kolom - 1) = jaar
    End If
    datum = .Cells(i, 2) & "-" & .Cells(i, 3) & "-" & .Cells(i, 4)
    dopeling = .Cells(i, 9) & " " & .Cells(i, 10)
    If .Cells(i, 8) = "m" Then gslcht = "fs. "
    If .Cells(i, 8) = "v" Then gslcht = "fa. "
    ouders = gslcht & .Cells(i, 11) & " " & .Cells(i, 12) & " & " & .Cells(i, 13)
    If .Cells(i, 11) = "onwettig" Then ouders = gslcht & .Cells(i, 12) & " " & .Cells(i, 13)
    doopgetuigen = .Cells(i, 14) & " " & .Cells(i, 15) & " & " & .Cells(i, 16) & " " & .Cells(i, 17)
    Sheets("DIG_G_PR").Cells(rij, kolom).Resize(4) = Application.Transpose(Array(datum, dopeling, ouders, doopgetuigen))
    vorig = jaar
    rij = rij + 6
  Next i
End With

End Sub

Groetjes,
Molly

BlackDevil · « **Reactie #23 Gepost op:** 17 januari 2024, 17:45:30 »

Hey Molly,

Geen probleem hoor... we hebben allemaal een persoonlijk leven dat sowieso prioritair is hé

.

Bedankt voor jouw aanpassing van het codeblokje... het leest inderdaad wel beter

Nu is het wel zo dat ik de layout van het doelblad aanzienlijk heb moeten aanpassen (de layout in het testbestandje was nog uit een vorig project met een iets ander einddoel) omwille van praktische redenen waardoor ik jouw aanpassing lichtjes heb moeten wijzigen mbt die nieuwe layout en de wijze waarop de gegevens dan samengevat dienen weggeschreven te worden. Maar het is me gelukt, alles wordt correct weggeschreven.
Dit is dan de uiteindelijke "sub dataprint()" :

Code: [Selecteer]

Sub dataprint()
  kolom = -2
  rij = 5
  With Sheets("data")
    For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
      jaar = .Cells(i, 4)
      If jaar <> vorig Or rij > 40 Then
        kolom = kolom + 4
        rij = 5
        Sheets("DIG_G_PR").Cells(3, kolom - 1) = jaar
      End If
      
      datum = Left("00", Len("00") - Len(.Cells(i, 2))) & .Cells(i, 2) & "-" & Left("00", Len("00") - Len(.Cells(i, 3))) & .Cells(i, 3) & "-" & .Cells(i, 4)
      If .Cells(i, 8) = "m" Then tekst = "baptizatus est " & .Cells(i, 10) & ", filius "
      If .Cells(i, 8) = "v" Then tekst = "baptizata est " & .Cells(i, 10) & ", filia "
      If .Cells(i, 11) <> "onwettig" Then tekst = tekst & .Cells(i, 9) & " " & .Cells(i, 11) & " et " & .Cells(i, 12) & " " & .Cells(i, 13)
      If .Cells(i, 11) = "onwettig" And .Cells(i, 8) = "m" Then tekst = tekst & "illegitimus " & .Cells(i, 12) & " " & .Cells(i, 13)
      If .Cells(i, 11) = "onwettig" And .Cells(i, 8) = "v" Then tekst = tekst & "illegitima " & .Cells(i, 12) & " " & .Cells(i, 13)
      If .Cells(i, 18) = "" Then tekst = tekst & ", patrinus est " & .Cells(i, 14) & " " & .Cells(i, 15) & " et matrina est " & .Cells(i, 16) & " " & .Cells(i, 17)
      If Left(.Cells(i, 18), 13) = "peter in loco" Then tekst = tekst & ", patrinus est " & .Cells(i, 14) & " " & .Cells(i, 15) & Mid(.Cells(i, 18), 7) & " et matrina est " & .Cells(i, 16) & " " & .Cells(i, 17)
      If Left(.Cells(i, 18), 13) = "meter in loco" Then tekst = tekst & ", patrinus est " & .Cells(i, 14) & " " & .Cells(i, 15) & " et matrina est " & .Cells(i, 16) & " " & .Cells(i, 17) & Mid(.Cells(i, 18), 6)
  
      Sheets("DIG_G_PR").Cells(rij, kolom - 1) = datum
      Sheets("DIG_G_PR").Cells(rij, kolom) = tekst
      vorig = jaar
      rij = rij + 5
    Next i
  End With
End Sub

groetjes,
Bieke

BlackDevil · « **Reactie #24 Gepost op:** 18 januari 2024, 06:30:16 »

Goedemorgen allemaal,

Na succesvol de layout-code en de wegschrijf-code voor het onderdeel “digitale akten” te hebben afgewerkt heb ik deze samengevoegd tot één procedure.
Om zeker te zijn dat ik altijd het juiste aantal ‘paginas’ aanmaak met de layout-code heb ik een codeblokje geschreven welke het einde van de loop zal bepalen.
De code werkt perfect, het juiste aantal wordt berekend maar m.i. moet dit korter en/of efficiënter kunnen.

Dit is wat ik er voorlopig van gemaakt heb :

Code: [Selecteer]

Sub digdpn()
  Dim par As Variant, totaal As Long, begin As Long, einde As Long, aantal As Long, i As Long, paginas As Long, tdlk As Long, kols As Long
'    par = InputBox("Welke parochie wenst u te digitaliseren?", "Parochie-keuze")
    par = "Parochie 1"
    totaal = Sheets("IDX_G").Cells(Rows.Count, 1).End(xlUp).Row
    begin = Sheets("IDX_G").Range("A1:A" & totaal).Find(par, SearchDirection:=xlNext).Row
    einde = Sheets("IDX_G").Range("A1:A" & totaal).Find(par, SearchDirection:=xlPrevious).Row
    aantal = einde - begin + 1
    For i = begin To einde
      jaar = Sheets("IDX_G").Cells(i, 4)
      tdlk = tdlk + 1
      If jaar <> vorig Then
        If tdlk Mod 8 > 0 Then paginas = paginas + 1
        paginas = paginas + ((tdlk - tdlk Mod 8) / 8)
        tdlk = 0
      End If
      vorig = jaar
    Next i
    kols = paginas * 4
End Sub

Kort samengevat, er zal steeds van één bepaalde parochie een “dataprint” moeten uitgevoerd worden.
De uitvoer is max 8 akten (rijen uit het bronblad) van hetzelfde jaar per pagina.

Bovenstaande code vraagt eerst, via inputbox, aan de gebruiker de naam van de gewenste parochie.
(dit lijntje code is eventjes uitgeschakeld voor de praktische kant van het testen, er werd dus tijdelijk een vaste waarde in de plaats gezet)
Adhv de ingevoerde parochie gaat de code eerst kijken van welke rij tot welke rij de akten van die parochie zich bevinden. Op basis daarvan gaat de code dan, binnen die bepaalde range, kijken naar de jaartallen en hoe vaak elk jaar voorkomt om alzo het benodigd aantal pagina’s te berekenen.
Die totaal-waarde wordt dan vermenigvuldigd met 4 omdat er om de 4 kolommen een pagina gemaakt wordt.
In de layout-code komt dan de vermenigvuldigde waarde als einde van de loop (for i = 1 to waarde Step 4).

Omdat mijn vba-kennis nog vrij ‘basic’ is zijn mijn coderingen vaak te omvangrijk door de simpliciteit ervan. Maar omdat ik enerzijds leergierig ben en anderzijds redelijk perfectionistisch, probeer ik altijd een zo kort mogelijke (doch begrijpbare) code na te streven.

Dus als bovenstaand codeblok op een begrijpbare manier kan ingekort/verbeterd worden dan lees/leer ik graag hoe dat eventueel kan.

Alvast dank op voorhand.
Groetjes,
Bieke

BlackDevil · « **Reactie #25 Gepost op:** 18 januari 2024, 09:43:53 »

zelf al wat verder ingekort tot dit :

Code: [Selecteer]

Sub digdpn()
  Dim ws1 As Worksheet, par As Variant, i As Long, paginas As Long, tdlk As Long, kols As Long, jaar As Variant, vorig As Variant
  Set ws1 = Sheets("IDX_G")
'    par = InputBox("Welke parochie wenst u te digitaliseren?", "Parochie-keuze")
    par = "Parochie 1"
    For i = ws1.Columns(1).Find(par, SearchDirection:=xlNext).Row To ws1.Columns(1).Find(par, SearchDirection:=xlPrevious).Row
      jaar = ws1.Cells(i, 4)
      tdlk = tdlk + 1
      If jaar <> vorig Then
        If tdlk Mod 8 > 0 Then paginas = paginas + 1
        paginas = paginas + ((tdlk - tdlk Mod 8) / 8)
        tdlk = 0
      End If
      vorig = jaar
    Next i
    kols = paginas * 4
End Sub

MollyVH · « **Reactie #26 Gepost op:** 18 januari 2024, 10:25:25 »

Hey Bieke,

Je zou dit stukje code ook gewoon 'overbodig' kunnen noemen

Om dat duidelijk te maken heb ik het vlug in je laatste voorbeeld opgenomen waarbij de verdwenen lijntjes code in commentaar zijn gezet, en de gewijzigde of toegevoegde lijntjes dat als commentaar hebben meegekregen.
De code die ik je vorige keer bezorgde bevatte namelijk al een methode om naar een volgende set kolommen te springen, en je kan die gebruiken om 'blanco' kolommen toe te voegen. Het lijkt misschien een brug te ver, maar in zijn totaliteit zal je processor dan minder werk hebben.

Ik kon natuurlijk geen rekening houden met

Citaat

Nu is het wel zo dat ik de layout van het doelblad aanzienlijk heb moeten aanpassen (de layout in het testbestandje was nog uit een vorig project)

maar mocht je dit willen implementeren in je nieuwste bestand, dan heb je daar hooguit een minuutje werk mee (weinig groen in mijn voorbeeld

)

Groetjes,
Molly

MollyVH · « **Reactie #27 Gepost op:** 18 januari 2024, 11:35:26 »

***update***

Waar ik het niet over had (omdat ik niet over de vereiste layout beschik), maar waarvan zowel ikzelf als je pc nóg veel vrolijker zouden worden, is als je 'layout2' zou opsplitsen in 1) een deel dat je eenmalig (in principe zou ik 'manueel' zeggen, maar kan ook met de bestaande code) doet zoals rijhoogte, lettertype, kleur... en 2) de zaken die afhankelijk zijn van het aantal kolommen.
Het zou de definitieve 'layout2' significant korter en efficiënter maken!

Groetjes,
Molly

BlackDevil · « **Reactie #28 Gepost op:** 18 januari 2024, 11:54:08 »

Hey Molly,

Alweer bedankt voor een prachtige oplossing $_/-\o_$
dat is eigenlijk het exacte resultaat dat ik wou verkrijgen

....echter...

Citaat van: MollyVH op 18 januari 2024, 10:25:25

mocht je dit willen implementeren in je nieuwste bestand, dan heb je daar hooguit een minuutje werk mee (weinig groen in mijn voorbeeld )

door de toch aanzienlijk grote wijziging in de layout-code en daarmee ook de wegschrijf-code vrees ik dat het voor mij véél langer zal duren dan een minuutje om dit in de nieuwe versie te implementeren

.

Ook dient er sowieso een deel van dat code-blokje uit mijn reactie #25 gebruikt te worden in de wegschrijfcode...
Namelijk dit gedeelte

Code: [Selecteer]

'    par = InputBox("Welke parochie wenst u te digitaliseren?", "Parochie-keuze")
    par = "Parochie 1"  
    For i = ws1.Columns(1).Find(par, SearchDirection:=xlNext).Row To ws1.Columns(1).Find(par, SearchDirection:=xlPrevious).Row

waarbij de juiste parochie bepaald dient te worden zodat enerzijds enkel de akten van die parochie verwerkt worden en anderzijds zodat op het doelblad, bovenaan in de eerste rij, het woordje "Parochie" kan gewijzigd worden in de werkelijke parochie-naam.

In bijlage mijn bestand met de nieuwe layout- en wegschrijfcode.

groetjes,
Bieke

P.S.: net toen ik op 'verzenden' wou klikken kreeg ik melding van een nieuwe reactie

*edit*
P.S.2 : Wat ik ook nog niet vermeld had (geen idee of het al dan niet relevant is) maar deze layout- en wegschrijfcode is nog maar een eerste van in totaal 6 diverse layout- en wegschrijfcodes.... Deze is namelijk enkel maar voor de dopen (PR), ik moet er dan
nog eentje maken voor de geboorten (BS), huwelijken (PR), huwelijken (BS), overlijdens (PR) en overlijden (BS)...
Dus mogelijks zal er ergens een deel code zijn dat voor alle 6 de versies identiek is en dan mogelijks in een aan te roepen sub geplaatst kan worden ipv 6x hetzelfde codeblokje te vermelden.

BlackDevil · « **Reactie #29 Gepost op:** 18 januari 2024, 15:09:52 »

***update***

Naar aanleiding van mijn "P.S.2" opmerking uit mijn vorig bericht mbt de 6 diverse 'uitvoeren' ben ik eens gaan kijken welke onderdelen van de lay-out ik op alle 6 de 'uitvoeren' van toepassing kan laten zijn.
En omdat ik de weergave op papier nog niet echt in detail bekeken had (grotendeels enkel de weergave op scherm) heb ik er ineens van geprofiteerd om een lay-out te creëren die ook een correcte weergave op papier geeft.

Ik heb dus een nieuw codeblok geschreven voor de 'algemene' layout, dus die voor alle 6 de 'uitvoeren' gebruikt moet worden.
En dat zijn voornamelijk de lettertypes, tekstkleuren, lettergroottes, letterstijlen en kolombreedtes voor de volledige pagina alsook de samengevoegde cellen voor de eerste vier rijen + de rijhoogte van de 4e rij.

De samenvoeging van cellen met de onderste border vanaf rij 5 zijn dan afzonderlijk per soort uitvoer waarbij vooral het aantal samen te voegen rijen per kolom verschillend zal zijn. (deze code staat als commentaar onder de sub layoutalg().

de sub voor de algemene layout heb ik achter de module "mod_layouts" geplaatst
In bijlage dus mijn recentste bestand (v2.0b).

groetjes,
Bieke

Help!

Menu

Hulp bij posten

Zoeken

Recente topics

Auteur Topic: vba for..next..-loop wegschrijfvraagje (gelezen 9937 keer)

BlackDevil

Re: vba for..next..-loop wegschrijfvraagje

BlackDevil

Re: vba for..next..-loop wegschrijfvraagje

BlackDevil

Re: vba for..next..-loop wegschrijfvraagje

BlackDevil

Re: vba for..next..-loop wegschrijfvraagje

BlackDevil

Re: vba for..next..-loop wegschrijfvraagje

BlackDevil

Re: vba for..next..-loop wegschrijfvraagje

BlackDevil

Re: vba for..next..-loop wegschrijfvraagje

MollyVH

Re: vba for..next..-loop wegschrijfvraagje

BlackDevil

Re: vba for..next..-loop wegschrijfvraagje

BlackDevil

Re: vba for..next..-loop wegschrijfvraagje

BlackDevil

Re: vba for..next..-loop wegschrijfvraagje

MollyVH

Re: vba for..next..-loop wegschrijfvraagje

MollyVH

Re: vba for..next..-loop wegschrijfvraagje

BlackDevil

Re: vba for..next..-loop wegschrijfvraagje

BlackDevil

Re: vba for..next..-loop wegschrijfvraagje