Printen op voorwaarde uit elke waarde uit lijst met verschillende waarden

[Lummel]

Voor elke unieke waarde die voorkomt in AV:AZ in bestand "Overzicht klanten" moet een aparte modelbrief aangemaakt worden.
Elke nr van de modelbrief correspondeert met bepaalde voorwaarden en korting.

Dus bijv. voor elke celwaarde in AV:AZ=2 dan moet het kortings% opgehaald worden uit sheet Model kolom C. De klantnaam komt uit kolom BA van "Overzicht klanten".
Het bestand "Brief" is mijns inziens leidend.
Zoals het nu is werkt het enkel voor 1 klant. Om dit voor alle te doen kom ik niet uit.

Via Word met afdruk samenvoegen zou ook een optie zijn, maar hoe dan het kortings% op te zoeken is mij de vraag...

Ik hoop dat het een beetje duidelijk is.

Suggesties en hulp zijn welkom!

 

[Lummel]

Is hetgeen ik wil onmogelijk?? Iemand dan een suggestie hoe ik het anders zou kunnen oplossen?

 

[KevZ]

Met VBA zou je vrij gemakkelijk unieke bestanden(brieven) kunnen aanmaken per klant voorstel (of gelijk afdrukken). Ik vind de bestanden echter heel onduidelijk en je vraag ook.

-Je wilt per unieke waarde in AV:AZ 1 brief maken, dus als cijfer 61 meerdere keren voorkomt maak je alleen een brief voor de eerste klant? Of moet elke klant meerdere brieven krijgen, klant23 heeft zo te zien 5 brieven?

-De korting vanaf model 51 zorgt voor reken problemen, dit zou je moeten aanpassen.

 

[abevleeming]

Ik snap er ook nog niet zo veel van... Op zich is je vraag nog redelijk te begrijpen, maar je voorbeeld bestanden valt niet zoveel van te begrijpen.
Even wat vragen:
Heb je uiteindelijk +/- 80 modelbrieven?
Moet nu bijvoorbeeld "klantnaam 5" drie verschillende modelbrieven (1, 63 en 74) krijgen?

 

[Lummel]

Een klant kan meerdere brieven krijgen; dus klant 23 krijgt idd 5 brieven.
Elk nr correspondeert met een brief. Er zijn echter geen 80 verschillende brieven, wel 80 mogelijke combinaties. De 2 brieven uit het voorbeeld zijn geschikt voor de nrs 1 t/m 36.
Overigens heb ik de andere brieven nog niet gemaakt.
In de brief zijn alleen cel A3 (=naam klant) en D5 (=standaardpremie-kortings%) variabel.

Het overzicht klanten bevat in AV t/m AZ de geldende combinatie voor de betreffende klant. Deze wordt opgezocht in tab Model.

Ik hoop dat dit het enigszins verduidelijkt.

Het is de bedoeling dat (het liefst automatisch via knop) voor elke klant de juiste brief/brieven geprint worden.

 

[KevZ]

Het lukt mij niet om een bestand te uploaden, te groot. Maar als je onderstaande code in een module zet in Overzicht klanten, dan doet het volgens mij wat je vraagt. Hij slaat wel fouten over, zoals alle kortingen vanaf model 51.

Plak deze formule in cel BB7(Overzicht klanten): =ALS.FOUT(VERT.ZOEKEN(BB6;Model!B4:C85;2;0);0)

Zet alle bestanden open, voer de macro uit.
Let echter wel op dat hij alles afdrukt.
Houd ESC ingedrukt om vroegtijdig te stoppen.

Onderstaande code verdient geen schoonheidsprijs

Sub afdrukbrief()

On Error Resume Next
Windows("Standaardtabel AA incl btld").Activate
B_premie = Sheets("AA incl btld").Range("C4").Value

Windows("OVERZICHT KLANTEN").Activate
 Sheets("Contract- en RC-nummers").Activate
  Range("BA7").Select
   Do Until ActiveCell.Value = ""
    Klant = ActiveCell.Value
    Korting = 0
    Bedrag = 0
    For i = 1 To 5
     model = ActiveCell.Offset(0, -i).Value
      If Not model = "" Then
       Range("BB6").Value = model
       Korting = Range("BB7").Value
       Bedrag = B_premie * (1 - (Korting / 100))
       If Bedrag > 0 Then
        Windows("Brief").Activate
         Sheets("Dooreen").Range("D5").Value = Bedrag
         Sheets("Dooreen").Range("A3").Value = "t.b.v. personeel " & Klant
         Sheets("Dooreen").PrintOut
         Sheets("Leeftijdsafh").Range("D5").Value = Bedrag
         Sheets("Leeftijdsafh").Range("A3").Value = "t.b.v. personeel " & Klant
         Sheets("Leeftijdsafh").PrintOut
        End If
       End If
      Windows("OVERZICHT KLANTEN").Activate
     Next
     ActiveCell.Offset(1, 0).Select
    Loop
       
On Error GoTo 0

End Sub

 

[Lummel]

Thanks.
Zonder de bestandsextensie toe te voegen werkt het niet.

Wat gaat nog fout:
- brief Doreen moet afgedrukt worden als kolom G in Model een D staat; leeftijdsafhankelijk als er een L staat.
Hierdoor wordt bijv. nr 2 1x teveel afgedrukt

- voor deze brief geldt nr 1-36

 

[Lummel]

Ik heb nu de volgende code. Deze werkt en doet wat hij moet doen, echter elke brief wordt apart aangemaakt waardoor de verwerking behoorlijk lang duurt. Hoe kan ik het versnellen, zodat ze bijv. op de achtergrond worden afgedrukt?

Sub Printbrief_AA_btld()

On Error Resume Next
Windows("Standaardtabel AA incl btld.xlsx").Activate
B_premie = 106.95 'Sheets("AA incl btld").Range("C4").Value

Windows("OVERZICHT KLANTEN.xlsm").Activate
 Sheets("Contract- en RC-nummers").Activate
  Range("BA7").Select
   Do Until ActiveCell.Value = ""
     Klant = ActiveCell.Value
     Korting = 0
     Bedrag = 0
     model = ActiveCell.Offset(0, -5).Value    ' 5 kolommen terug vanaf BA7
     If Not model = "" Then
       Range("BB6").Value = model
       Korting = Range("BB7").Value
       Termijn = Range("BB8").Value
       Bedrag = B_premie * (1 - (Korting / 100))
       If Bedrag > 0 Then
          Windows("BriefAA incl btld.xlsx").Activate
          If Termijn = "D" Then
             Sheets("Dooreen").Range("D5").Value = Bedrag
             Sheets("Dooreen").Range("A3").Value = "t.b.v. personeel " & Klant
             Sheets("Dooreen").PrintOut
             'Sheets("Dooreen").PrintPreview
          End If
          If Termijn = "L" Then
             Sheets("Leeftijdsafh").Range("D5").Value = Bedrag
             Sheets("Leeftijdsafh").Range("A3").Value = "t.b.v. personeel " & Klant
             Sheets("Leeftijdsafh").PrintOut
             'Sheets("Leeftijdsafh").PrintPreview
          End If
       End If
     End If
     Windows("OVERZICHT KLANTEN.xlsm").Activate
     ActiveCell.Offset(1, 0).Select
    Loop
       
On Error GoTo 0
End Sub

 

[KevZ]

Hoi,

Goed dat je hem zelf hebt weten te verbeteren.
Zonder al te veel aanpassingen te hoeven doen, zou je het volgende kunnen doen:

Sub Printbrief_AA_btld()

[B]Application.screenupdating = False
Application.Calculation = xlCalculationManual[/B]

On Error Resume Next
Windows("Standaardtabel AA incl btld.xlsx").Activate
B_premie = 106.95 'Sheets("AA incl btld").Range("C4").Value

Windows("OVERZICHT KLANTEN.xlsm").Activate
 Sheets("Contract- en RC-nummers").Activate
  Range("BA7").Select
   Do Until ActiveCell.Value = ""
     Klant = ActiveCell.Value
     Korting = 0
     Bedrag = 0
     model = ActiveCell.Offset(0, -5).Value    ' 5 kolommen terug vanaf BA7
     If Not model = "" Then
       Range("BB6").Value = model
       Korting = Range("BB7").Value
       Termijn = Range("BB8").Value
       Bedrag = B_premie * (1 - (Korting / 100))
       If Bedrag > 0 Then
          Windows("BriefAA incl btld.xlsx").Activate
          If Termijn = "D" Then
             Sheets("Dooreen").Range("D5").Value = Bedrag
             Sheets("Dooreen").Range("A3").Value = "t.b.v. personeel " & Klant
             Sheets("Dooreen").PrintOut
             'Sheets("Dooreen").PrintPreview
          End If
          If Termijn = "L" Then
             Sheets("Leeftijdsafh").Range("D5").Value = Bedrag
             Sheets("Leeftijdsafh").Range("A3").Value = "t.b.v. personeel " & Klant
             Sheets("Leeftijdsafh").PrintOut
             'Sheets("Leeftijdsafh").PrintPreview
          End If
       End If
     End If
     Windows("OVERZICHT KLANTEN.xlsm").Activate
     ActiveCell.Offset(1, 0).Select
    Loop

[B]Application.screenupdating = True
Application.Calculation = xlCalculationAutomatic
[/B]
      
On Error GoTo 0
End Sub