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 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182
| Sub Transfert_des_cnp()
' suivi des groupes professionnels
grp0 = 3
grp1 = 5
grp2 = 7
grp3 = 9
grp4 = 11
grp5 = 13
grp6 = 15
grp7 = 17
grp8 = 19
grp9 = 21
cleared = False
ligneaeffacer = 2
' procédure pour effacer la feuille Version imprimable avant chaque transfert
' des offres pour éviter les offres en double
Do While Not cleared
ligneaeffacer = ligneaeffacer + 2
eogrp = False
' boucle pour effacer groupe par groupe
Do While Not eogrp
If Not Worksheets("Version imprimable").Cells(ligneaeffacer, 1) = Empty Then
temp = ligneaeffacer + 1
If Worksheets("Version imprimable").Cells(temp, 1).Value = Empty Then
Worksheets("Version imprimable").Rows(ligneaeffacer).ClearContents
Worksheets("Version imprimable").Rows(temp).Delete
Else: Worksheets("Version imprimable").Rows(ligneaeffacer).Delete
End If
Else: eogrp = True
End If
Loop
If ligneaeffacer > 22 Then
cleared = True
End If
Loop
transfert = False
lignet = 3
colonnet = 3
' Boucle pour transferer les offres d'emploi sur la feuille
' pour l'impression
Do While Not transfert
Vide = False
colonnec = 1
lignet = lignet + 1
' Vérifie si la colonne "CNP" est vide; si oui, fin de
' la boucle pour le transfert des ofres d'emploi
If Worksheets("Saisie").Cells(lignet, colonnet).Value = Empty Then
transfert = True
Else
' Vérifie si la colonne "Fermé" est vide; si oui, on
' vérifie si l'offre a expirée
If Worksheets("Saisie").Cells(lignet, 19).Value = Empty Then
date2 = Worksheets("Saisie").Cells(lignet, 18).Value
perime = DateDiff("d", date2, Now)
' Si la date de fin d'affichage a expirée, un "X" est écrit
'dans la colonne "Fermé" de l'offre en cours
If perime > 0 Then
Worksheets("Saisie").Cells(lignet, 19).Value = "X"
End If
End If
bongrp = 1000
changerdoffre = False
Dim tempo As Integer
Do While Not changerdoffre
tempo = Worksheets("Saisie").Cells(lignet, colonnet).Value
If tempo < bongrp Or bongrp = 10000 Then
changerdoffre = True
If bongrp = 1000 Then
lignec = grp0 + 1
ElseIf bongrp = 2000 Then
lignec = grp1 + 1
ElseIf bongrp = 3000 Then
lignec = grp2 + 1
ElseIf bongrp = 4000 Then
lignec = grp3 + 1
ElseIf bongrp = 5000 Then
lignec = grp4 + 1
ElseIf bongrp = 6000 Then
lignec = grp5 + 1
ElseIf bongrp = 7000 Then
lignec = grp6 + 1
ElseIf bongrp = 8000 Then
lignec = grp7 + 1
ElseIf bongrp = 9000 Then
lignec = grp8 + 1
ElseIf bongrp = 10000 Then
lignec = grp9 + 1
End If
Do While Not Vide
' Boucle pour trouver la première ligne vide de la feuille
' d'impression pour inscrire l'offre au bon endroit
If Worksheets("Version imprimable").Cells(lignec, colonnec).Value = Empty Then
Vide = True
Else: lignec = lignec + 1
End If
Loop
' Si la colonne "Fermé" est vide, transfert de l'offre d'emploi
If Worksheets("Saisie").Cells(lignet, 19).Value = Empty Then
toutelaligne = False
colc = 0
' Transfert de chaque cellule de l'offre d'emploi
Do While Not toutelaligne
If colc < 18 Then
colc = colc + 1
Worksheets("Saisie").Cells(lignet, colc).Copy Worksheets("Version imprimable").Cells(lignec, colc)
Else
toutelaligne = True
End If
Loop
prochaineligne = lignec + 1
' Insertion d'une nouvelle ligne pour la prochaine offre
' d'emploi dans la même tranche de CNP
Worksheets("Version imprimable").Rows(prochaineligne).Insert
' réajustment des sections des groupes professionels qui suivent
If bongrp = 1000 Then
grp1 = grp1 + 1
grp2 = grp2 + 1
grp3 = grp3 + 1
grp4 = grp4 + 1
grp5 = grp5 + 1
grp6 = grp6 + 1
grp7 = grp7 + 1
grp8 = grp8 + 1
grp9 = grp9 + 1
ElseIf bongrp = 2000 Then
grp2 = grp2 + 1
grp3 = grp3 + 1
grp4 = grp4 + 1
grp5 = grp5 + 1
grp6 = grp6 + 1
grp7 = grp7 + 1
grp8 = grp8 + 1
grp9 = grp9 + 1
ElseIf bongrp = 3000 Then
grp3 = grp3 + 1
grp4 = grp4 + 1
grp5 = grp5 + 1
grp6 = grp6 + 1
grp7 = grp7 + 1
grp8 = grp8 + 1
grp9 = grp9 + 1
ElseIf bongrp = 4000 Then
grp4 = grp4 + 1
grp5 = grp5 + 1
grp6 = grp6 + 1
grp7 = grp7 + 1
grp8 = grp8 + 1
grp9 = grp9 + 1
ElseIf bongrp = 5000 Then
grp5 = grp5 + 1
grp6 = grp6 + 1
grp7 = grp7 + 1
grp8 = grp8 + 1
grp9 = grp9 + 1
ElseIf bongrp = 6000 Then
grp6 = grp6 + 1
grp7 = grp7 + 1
grp8 = grp8 + 1
grp9 = grp9 + 1
ElseIf bongrp = 7000 Then
grp7 = grp7 + 1
grp8 = grp8 + 1
grp9 = grp9 + 1
ElseIf bongrp = 8000 Then
grp8 = grp8 + 1
grp9 = grp9 + 1
Else: grp9 = grp9 + 1
End If
End If
Else: bongrp = bongrp + 1000
End If
Loop
End If
Loop
' ouverture de la feuille Version imprimable
Worksheets("Version imprimable").Activate
End Sub |
Partager