1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122
| Sub alim_Pyer_cotisations2()
Dim ws(8) As Worksheet
Dim rpp, garantie, survenance As String
Dim i As Integer
For i = 6 To 16 'boucle sur l'ensemble des numéros de contrat et va chercher le montant des primes dans le tableau croisé dynamique'
Set ws(1) = ThisWorkbook.Worksheets("cotsin")
Set ws(2) = ThisWorkbook.Worksheets("cotisations2006")
ws(2).Cells(2, 2).Value = ws(1).Cells(i, 1).Value
Sheets("cotisations2006").Select
rpp = Range("cotisations2006!b2").Value
survenance = Range("cotisations2006!b3").Value
ActiveSheet.PivotTables("Primes").PivotFields("N° Rpp").CurrentPage = rpp
'ActiveSheet.PivotTables("Primes").PivotFields("Année Survenance").CurrentPage = survenance
'remplissage de la base globale COT-SIN garantie par garantie et détail du type de prime'
'garantie décès'
If ws(2).Cells(10, 3).Value <> "" Then
ws(1).Cells(i, 2).Value = ws(2).Cells(10, 3).Value
ws(1).Cells(i, 10).Value = "Primes définitives"
ElseIf (ws(2).Cells(10, 2).Value > 0 Or ws(2).Cells(10, 4).Value > 0) Then
ws(1).Cells(i, 2).Value = Application.WorksheetFunction.Max(ws(2).Cells(10, 2).Value, ws(2).Cells(10, 4).Value)
If ws(2).Cells(10, 2).Value < ws(1).Cells(10, 4).Value Then
ws(1).Cells(i, 10).Value = "Primes Provisoires"
Else
ws(1).Cells(i, 10).Value = "encaissements"
End If
End If
'garantie décès accidentel'
If ws(2).Cells(11, 3).Value <> "" Then
ws(1).Cells(i, 8).Value = ws(2).Cells(11, 3).Value
ws(1).Cells(i, 16).Value = "Primes définitives"
ElseIf (ws(2).Cells(11, 2).Value > 0 Or ws(2).Cells(11, 4).Value > 0) Then
ws(1).Cells(i, 8).Value = Application.WorksheetFunction.Max(ws(2).Cells(11, 2).Value, ws(2).Cells(11, 4).Value)
If ws(2).Cells(11, 2).Value < ws(1).Cells(11, 4).Value Then
ws(1).Cells(i, 16).Value = "Primes Provisoires"
Else
ws(1).Cells(i, 16).Value = "encaissements"
End If
End If
'garantie rente de conjoint'
If ws(2).Cells(16, 3).Value <> "" Then
ws(1).Cells(i, 4).Value = ws(2).Cells(16, 3).Value
ws(1).Cells(i, 12).Value = "Primes définitives"
ElseIf (ws(2).Cells(16, 2).Value > 0 Or ws(2).Cells(16, 4).Value > 0) Then
ws(1).Cells(i, 4).Value = Application.WorksheetFunction.Max(ws(2).Cells(16, 2).Value, ws(2).Cells(16, 4).Value)
If ws(2).Cells(16, 2).Value < ws(1).Cells(16, 4).Value Then
ws(1).Cells(i, 12).Value = "Primes Provisoires"
Else
ws(1).Cells(i, 12).Value = "encaissements"
End If
End If
'garantie rente éducation'
If ws(2).Cells(17, 3).Value <> "" Then
ws(1).Cells(i, 3).Value = ws(2).Cells(17, 3).Value
ws(1).Cells(i, 11).Value = "Primes définitives"
ElseIf (ws(2).Cells(17, 2).Value > 0 Or ws(2).Cells(17, 4).Value > 0) Then
ws(1).Cells(i, 3).Value = Application.WorksheetFunction.Max(ws(2).Cells(17, 2).Value, ws(2).Cells(17, 4).Value)
If ws(2).Cells(16, 2).Value < ws(1).Cells(17, 4).Value Then
ws(1).Cells(i, 11).Value = "Primes Provisoires"
Else
ws(1).Cells(i, 11).Value = "encaissements"
End If
End If
' garantie RF '
If ws(2).Cells(18, 3).Value <> "" Then
ws(1).Cells(i, 7).Value = ws(2).Cells(18, 3).Value
ws(1).Cells(i, 15).Value = "Primes définitives"
ElseIf (ws(2).Cells(18, 2).Value > 0 Or ws(2).Cells(18, 4).Value > 0) Then
ws(1).Cells(i, 7).Value = Application.WorksheetFunction.Max(ws(2).Cells(18, 2).Value, ws(2).Cells(18, 4).Value)
If ws(2).Cells(18, 2).Value < ws(1).Cells(18, 4).Value Then
ws(1).Cells(i, 15).Value = "Primes Provisoires"
Else
ws(1).Cells(i, 15).Value = "encaissements"
End If
End If
'garantie "Incapacité Temporaire"
If ws(2).Cells(12, 3).Value <> "" Then
ws(1).Cells(i, 5).Value = ws(2).Cells(12, 3).Value
ws(1).Cells(i, 13).Value = "Primes définitives"
ElseIf (ws(2).Cells(12, 2).Value > 0 Or ws(2).Cells(12, 4).Value > 0) Then
ws(1).Cells(i, 5).Value = Application.WorksheetFunction.Max(ws(2).Cells(12, 2).Value, ws(2).Cells(12, 4).Value)
If ws(2).Cells(12, 2).Value < ws(1).Cells(12, 4).Value Then
ws(1).Cells(i, 13).Value = "Primes Provisoires"
Else
ws(1).Cells(i, 13).Value = "encaissements"
End If
End If
' garantie "Invalidité Permanente"'
If ws(2).Cells(13, 3).Value <> "" Then
ws(1).Cells(i, 6).Value = ws(2).Cells(13, 3).Value
ws(1).Cells(i, 14).Value = "Primes définitives"
ElseIf (ws(2).Cells(13, 2).Value > 0 Or ws(2).Cells(13, 4).Value > 0) Then
ws(1).Cells(i, 6).Value = Application.WorksheetFunction.Max(ws(2).Cells(13, 2).Value, ws(2).Cells(13, 4).Value)
If ws(2).Cells(13, 2).Value < ws(1).Cells(13, 4).Value Then
ws(1).Cells(i, 14).Value = "Primes Provisoires"
Else
ws(1).Cells(i, 14).Value = "encaissements"
End If
End If
Next i
End Sub |
Partager