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
| Sub SelectionDonnees()
nomPage = "Appro automatisé"
LigneSource = 3
LigneDest = 77
' Indice de la ligne de la source des données
i = 0
' Indice de la ligne de la destination des données
j = 0
If (Feuil1.Cells(LigneDest, 4) <> "") Then
SuppressionLigne
End If
' Affiche l'unité de nomenclature dans la zone
colonne_E = Feuil3.Cells(LigneSource, 5)
colonne_F = Feuil3.Cells(LigneSource, 6)
Feuil1.Cells(LigneDest - 3, 4) = colonne_E
Feuil1.Cells(LigneDest - 3, 5) = colonne_F
' On parcourt le tableau de la feuille 3 ligne par ligne depuis la 3eme ligne,
' tant que la colonne C n'est pas vide
While (Feuil3.Cells(LigneSource + i, 3) <> "")
' Auquel cas on va copier, cellule par cellule, les données qui nous interessent
' On copie les données avec un code article égale à celui de la case K7
If (Feuil3.Cells(LigneSource + i, 3) = Feuil1.Cells(7, 11)) Then
colonne_H = Feuil3.Cells(LigneSource + i, 8)
colonne_I = Feuil3.Cells(LigneSource + i, 9)
colonne_J = Feuil3.Cells(LigneSource + i, 10)
colonne_K = Feuil3.Cells(LigneSource + i, 11)
colonne_M = Feuil3.Cells(LigneSource + i, 13)
colonne_N = Feuil3.Cells(LigneSource + i, 14)
colonne_O = Feuil3.Cells(LigneSource + i, 15)
' Fusionne les colonnes EFGH et LM des lignes
With Worksheets(nomPage)
.Range(.Cells(LigneDest + j, 5), .Cells(LigneDest + j, 8)).Merge
.Range(.Cells(LigneDest + j, 12), .Cells(LigneDest + j, 13)).Merge
End With
Feuil1.Cells(LigneDest + j, 4) = colonne_H
With Worksheets(nomPage)
With .Range(.Cells(LigneDest + j, 5), .Cells(LigneDest + j, 8))
.Font.Name = "Arial"
.Font.Size = 10
.HorizontalAlignment = xlHAlignLeft
.VerticalAlignment = xlVAlignTop
.Value = colonne_I
.WrapText = True
End With
End With
Feuil1.Cells(LigneDest + j, 9) = colonne_J
Feuil1.Cells(LigneDest + j, 10) = colonne_K
Feuil1.Cells(LigneDest + j, 11) = colonne_M
Feuil1.Cells(LigneDest + j, 11).HorizontalAlignment = xlHAlignCenter
With Worksheets(nomPage)
With .Range(.Cells(LigneDest + j, 12), .Cells(LigneDest + j, 13))
.Font.Name = "Arial"
.Font.Size = 10
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignTop
.Value = colonne_N
End With
End With
Feuil1.Cells(LigneDest + j, 14) = colonne_O
Feuil1.Cells(LigneDest + j, 14).HorizontalAlignment = xlHAlignCenter
j = j + 1
' Dessine des lignes horizontales fines dans le tableau
With Worksheets(nomPage)
With .Range(.Cells(LigneDest + j - 1, 4), .Cells(LigneDest + j - 1, 14)).Borders
.Item(xlEdgeBottom).Weight = xlThin
End With
End With
End If
i = i + 1
Wend
' Dessine le contour et l'interieur du tableau
With Worksheets(nomPage)
With .Range(.Cells(LigneDest, 4), .Cells(LigneDest + j - 1, 14)).Borders
.Item(xlEdgeBottom).Weight = xlMedium
.Item(xlEdgeLeft).Weight = xlMedium
.Item(xlEdgeRight).Weight = xlMedium
End With
End With
' Dessine des lignes intérieures verticales fines dans le tableau
Dim objWorksheet As Worksheet, objRange As Range
Set objWorksheet = ThisWorkbook.ActiveSheet
Set objRange = objWorksheet.Range(objWorksheet.Cells(LigneDest, 4), objWorksheet.Cells(LigneDest + j - 1, 14))
With objRange.Borders
With .Item(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With
Feuil1.Cells(74, 12) = j
End Sub |
Partager