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 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296
| ' Dans les déclaraction
' Je declare un tableau de commande
Dim tabCommande() As Commande
Private Type Commande
Client As String
NomProduit As String
Atelier As String
NumLot As String
NbPalette As Integer
DateFinFab As Date
Pharmacien As String
End Type
Sub GenererFeuille()
'Cellule mise a jour quand on génère la plage en cliquant sur les bouton générer
nbLigneCommande = Feuil1.Cells(5, 8)
nbLigneDecalage = myConst.myLigneDecalage
Dim i, j, x, inc, nbFeuilles, nbPaletteTmp As Integer
nbPalettesTmp = 0
nbFeuilles = Worksheets.Count
'Définit la taille du tableau
ReDim TabNomFeuille(nbfeuille)
'MsgBox Worksheets.Count
' Tableau qui va servir à savoir si les pharmaciens ont bien été entré.
ReDim tabPharmacien(nbLigneCommande)
'**********
'*** boolean qui prendra la valeur false si un champ pharmacien n a pas été rempli
'**********
Dim pharmacienOk As Boolean
pharmacienOk = True
'**********
'*** On crée notre plage de données à trier
'**********
Dim plageDonnees, col1, col2 As String
plageDonnees = "A" & nbLigneDecalage & ":G" & nbLigneDecalage + Feuil1.Cells(5, 8) - 1
col1 = "D" & nbLigneDecalage
col2 = "B" & nbLigneDecalage
'**********
'*** Trie la plage de données par ordre alphabétique du numLot et du nomProduit
'**********
Range(plageDonnees).Select
Selection.Sort Key1:=Range(col1), Order1:=xlAscending, _
Key2:=Range(col2), Order2:=xlAscending, OrderCustom:=1, Orientation:=xlTopToBottom _
'**********
'*** On vérifie qu'on a bien saisi tous les pharmaciens
'**********
For j = 0 To nbLigneCommande - 1
If (Feuil1.Cells(nbLigneDecalage + j, 7) <> "") Then
tabPharmacien(j) = Feuil1.Cells(nbLigneDecalage + j, 7)
Else
MsgBox "Veuillez renseigner le nom du pharmacien à la ligne " & nbLigneDecalage + j
pharmacienOk = False
End If
Next j
'**********
'*** On vérifie si pr chaque couple numLot/nomProduit on a un meme pharmacien
'**********
For inc = 0 To nbLigneCommande - 1
NumLot = Feuil1.Cells(nbLigneDecalage + inc, 4)
NomProduit = Feuil1.Cells(nbLigneDecalage + inc, 2)
Pharmacien = Feuil1.Cells(nbLigneDecalage + inc, 7)
Do
If (Feuil1.Cells(nbLigneDecalage + inc + 1, 4) = NumLot) Then
If (Feuil1.Cells(nbLigneDecalage + inc + 1, 2) = NomProduit) Then
If (Pharmacien <> Feuil1.Cells(nbLigneDecalage + inc + 1, 7)) Then
MsgBox "Attention !" & vbCrLf & _
"Ligne " & nbLigneCommande + inc & " et Ligne " & nbLigneCommande + inc + 1 & vbCrLf & _
"Pour le numéro de lot """ & NumLot & """, les pharmaciens sont différents." & vbCrLf & _
"Ils devraient être identiques. Corrigez SVP"
'"nomProduit=" & nomProduit & vbCrLf & _
'"Pharmacien=" & Pharmacien
pharmacienOk = False
Exit Do
End If
End If
Else
Exit Do
End If
NumLot = Feuil1.Cells(nbLigneDecalage + inc + 1, 4)
NomProduit = Feuil1.Cells(nbLigneDecalage + inc + 1, 2)
Pharmacien = Feuil1.Cells(nbLigneDecalage + inc + 1, 7)
inc = inc + 1
Loop While inc < nbLigneCommande
Next inc
'**********
'*** On redimensionne le tableau en fonction du nombre de ligne
'**********
ReDim tabCommande(nbLigneCommande)
Dim newTailleTabCommande As Integer
newTailleTabCommande = nbLigneCommande
'**********
'*** On a bien selectionné tous les pharmaciens
'**********
If (pharmacienOk = True) Then
'**********
'*** Si la 1ere ligne est differente de "", on va recalculer la taille du tableau
'*** On diminue de "1" qd on est sur un meme numero de lot avec le meme nom de produit
'*** (aucun probleme pour les pharmaciens puisque le teste a été effectuer au dessus
'**********
If (Feuil1.Cells(nbLigneDecalage, 1) <> "") Then
For i = 0 To nbLigneCommande - 1
NumLot = Feuil1.Cells(nbLigneDecalage + i, 4)
'Pharmacien = Feuil1.Cells(nbLigneDecalage + inc, 7)
If (Feuil1.Cells(nbLigneDecalage + i + 1, 4) = NumLot) Then
NomProduit = Feuil1.Cells(nbLigneDecalage + i, 2)
If (Feuil1.Cells(nbLigneDecalage + i + 1, 2) = NomProduit) Then
newTailleTabCommande = newTailleTabCommande - 1
End If
End If
NumLot = Feuil1.Cells(nbLigneDecalage + i + 1, 4)
NomProduit = Feuil1.Cells(nbLigneDecalage + i + 1, 2)
'Pharmacien = Feuil1.Cells(nbLigneDecalage + i + 1, 7)
Next i
Else
MsgBox "Veuillez générer le tableau ""Semaine Précédente"" ou ""Semaine Courante"" avant de générer les vignettes"
End If
Dim laDate As Date
ReDim tabCommande(newTailleTabCommande)
j = 0
'**********
'*** On va regrouper les commandes par lot :
'*** - on compte les palettes
'*** - on vérifie la date et choisi la date la plus tard
'**********
For i = 0 To nbLigneCommande - 1
NomProduit = Feuil1.Cells(nbLigneDecalage + i, 2)
NumLot = Feuil1.Cells(nbLigneDecalage + i, 4)
nbPaletteTmp = Feuil1.Cells(nbLigneDecalage + i, 5)
laDate = Feuil1.Cells(nbLigneDecalage + i, 6)
Do While (NumLot = Feuil1.Cells(nbLigneDecalage + i + 1, 4) And NomProduit = Feuil1.Cells(nbLigneDecalage + i + 1, 2))
If (laDate < Feuil1.Cells(nbLigneDecalage + i + 1, 6)) Then
laDate = Feuil1.Cells(nbLigneDecalage + i + 1, 6)
End If
nbPaletteTmp = nbPaletteTmp + Feuil1.Cells(nbLigneDecalage + i + 1, 5)
i = i + 1
Loop
tabCommande(j).Client = Feuil1.Cells(nbLigneDecalage + i, 1)
tabCommande(j).NomProduit = Feuil1.Cells(nbLigneDecalage + i, 2)
tabCommande(j).Atelier = Feuil1.Cells(nbLigneDecalage + i, 3)
tabCommande(j).NumLot = Feuil1.Cells(nbLigneDecalage + i, 4)
tabCommande(j).NbPalette = nbPaletteTmp
tabCommande(j).DateFinFab = laDate
tabCommande(j).Pharmacien = Feuil1.Cells(nbLigneDecalage + i, 7)
If (i <> nbLigneCommande - 1) Then
NumLot = Feuil1.Cells(nbLigneDecalage + i + 1, 4)
End If
j = j + 1
Next i
End If
'**********
'*** Fin du "If (pharmacienOk = True)"
'**********
'For i = 0 To UBound(tabCommande) - 1
' Feuil1.Cells(24 + i, 1) = tabCommande(i).Client
' Feuil1.Cells(24 + i, 2) = tabCommande(i).NomProduit
' Feuil1.Cells(24 + i, 3) = tabCommande(i).Atelier
' Feuil1.Cells(24 + i, 4) = tabCommande(i).NumLot
' Feuil1.Cells(24 + i, 5) = tabCommande(i).NbPalette
' Feuil1.Cells(24 + i, 6) = tabCommande(i).DateFinFab
' Feuil1.Cells(24 + i, 7) = tabCommande(i).Pharmacien
'Next i
Dim tabTriPharmacien() As Commande
Dim tabTmp() As Commande
tabTriPharmacien() = tabCommande()
ReDim tabTmp(1)
Dim longueur As Integer
Dim permut As Integer
Dim retour As Integer
Dim ch1 As String
Dim ch2 As String
longueur = UBound(tabTriPharmacien)
'**********
'*** Tri à bulle, trie le tabTriPharmacien par ordre de nom de pharmacien
'**********
Do
permut = 0
For i = 0 To longueur - 1
ch1 = tabTriPharmacien(i).Pharmacien
ch2 = tabTriPharmacien(i + 1).Pharmacien
retour = comparCh(ch1, ch2)
If (retour = 2 And i <> 7) Then
tabTmp(0) = tabTriPharmacien(i)
tabTriPharmacien(i) = tabTriPharmacien(i + 1)
tabTriPharmacien(i + 1) = tabTmp(0)
permut = 1
End If
Next i
Loop While permut = 1
'*********
'*** Affichage des données stockées ds le tableau de commande
'*********
'For j = 0 To newTailleTabCommande - 1
'
' MsgBox "J=" & j & vbCrLf & _
' "Client: " & tabCommande(j).Client & vbCrLf & _
' "Produit: " & tabCommande(j).NomProduit & vbCrLf & _
' "Atelier: " & tabCommande(j).Atelier & vbCrLf & _
' "Lot: " & tabCommande(j).NumLot & vbCrLf & _
' "Nb Palettes: " & tabCommande(j).NbPalette & vbCrLf & _
' "Date: " & tabCommande(j).DateFinFab & vbCrLf & _
' "Pharmacien: " & tabCommande(j).Pharmacien
'
'
'
'Next j
'on génère les feuilles puis les étiquettes
'For i = 0 To UBound(tabcommande) - 1
'on créé une feuille si elle n existe pas encore
' If (Not FeuilleExiste(ThisWorkbook, tabcommande(i).Pharmacien)) Then
' sheets.Add.Name = tabcommande(i).Pharmacien
' sheets(tabcommande(i).Pharmacien).Move after:=Worksheets(Worksheets.Count)
'Sheets(tabCommande(i).Pharmacien).GenererEtiquette (tabCommande(i).Pharmacien)
' End If
'ensuite on va creer les vignettes
'le tableau est trié dans l'ordre alphabétique par rapport au numLot et designation
'Next i
' Ensuite j ai besoin de passer mon tableau de commande à la procedure
' GenererEtiquette mais je n y arrive pas :(
Dim VarTemp As Variant
VarTemp = tabTriPharmacien()
GenererEtiquette VarTemp
End Sub
Sub GenererEtiquette(ByVal VarTab As Variant)
Dim i, j, nbEtiquette, nbLigne As Integer
Dim monClasseur, pharma As String
Dim tabTrierCommande() As Commande
tabTrierCommande() = VarTab
...
End Sub |
Partager