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
| Sub STOCK()
'Enlève la protection de la feuille
'Sheets("STOCK").Unprotect
'Permet de faire une nouvelle acquisition du stock, supprime la feuille STOCK si elle existe déjà
Application.DisplayAlerts = False
For Each X In Sheets
If X.Name = "STOCK" Then X.Unprotect
Next
For Each X In Sheets
If X.Name = "STOCK" Then X.Delete
Next
Application.DisplayAlerts = True
Dim dernière_ligne As Integer
' Dernière ligne de la base stock
Workbooks.Open Filename:= _
"U:\STOCK MARO.xlsx"
Windows("STOCK MARO.xlsx").Activate
derniere_ligne = Sheets("Données").Range("A1").End(xlDown).Row
' Enregistrement du tableau
Dim tab_stock()
Dim ligne As Integer
ReDim tab_stock(derniere_ligne - 2, 4)
Windows("STOCK MARO.xlsx").Activate
ligne = 0
For i = 2 To derniere_ligne
Vemp = Left(Sheets("Données").Range("F" & i), 1)
If Vemp = 1 Then
tab_stock(ligne, 0) = Sheets("Données").Range("B" & i)
tab_stock(ligne, 1) = Sheets("Données").Range("F" & i)
tab_stock(ligne, 2) = Sheets("Données").Range("CM" & i)
tab_stock(ligne, 3) = Sheets("Données").Range("CX" & i)
ligne = ligne + 1
End If
Next
Workbooks("STOCK MARO.xlsx").Close SaveChanges:=False
'Affichage tableau dans excel
Sheets.Add(Sheets(Sheets.Count)).Name = "PREV"
Sheets.Add(Sheets(Sheets.Count)).Name = "TEMP"
For ligne = 2 To UBound(tab_stock)
Windows("Calcul.xlsm").Activate
Sheets("PREV").Range("A1") = "SKU"
Sheets("PREV").Range("A" & ligne) = tab_stock(ligne - 2, 0)
'Sheets("PREV").Range("B1") = "EMPLACEMENT"
'Sheets("PREV").Range("B" & ligne) = tab_stock(ligne - 2, 1)
Sheets("PREV").Range("B1") = "QUANTITE"
Sheets("PREV").Range("B" & ligne) = tab_stock(ligne - 2, 2)
'Sheets("PREV").Range("D1") = "QUALITE"
'Sheets("PREV").Range("D" & ligne) = tab_stock(ligne - 2, 3)
Next
ThisWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
[PREV!A1].CurrentRegion.Address(, , xlR1C1, True)).CreatePivotTable _
TableDestination:="TEMP!R1C1", _
TableName:="MonStock"
With Worksheets("TEMP").PivotTables("MonStock").PivotFields("SKU")
.Orientation = xlRowField
.Position = 1
End With
Worksheets("TEMP").PivotTables("MonStock").AddDataField Worksheets("TEMP").PivotTables( _
"MonStock").PivotFields("QUANTITE"), "Sum of QUANTITE", xlSum
Worksheets("TEMP").PivotTables("MonStock").PivotFields("SKU").AutoSort xlDescending, _
"Sum of QUANTITE"
' Mise à jour tabstock
Erase tab_stock()
Dim dligne_TCD As Integer
dligne_TCD = Sheets("TEMP").Range("A1").End(xlDown).Row
ReDim tab_stock(dligne_TCD - 2, 3)
For i = 3 To dligne_TCD - 1
Pos = 0
Pos = InStr(1, Sheets("TEMP").Range("A" & i), " ", 0) 'trouve la position de " "
tab_stock(i - 3, 0) = Left(Sheets("TEMP").Range("A" & i), Pos - 1) ' enregistre uniquement le SKU
tab_stock(i - 3, 1) = Sheets("TEMP").Range("B" & i) ' enregistre la quantité
Next
'Nettoyage classeur
Application.DisplayAlerts = False
Worksheets("PREV").Delete
Worksheets("TEMP").Delete
Application.DisplayAlerts = True
'Affichage EXCEL
Sheets.Add(Sheets(Sheets.Count)).Name = "STOCK"
Sheets("STOCK").Move After:=Sheets(2)
For ligne = 2 To UBound(tab_stock)
Sheets("STOCK").Range("A1") = "SKU"
Sheets("STOCK").Range("A" & ligne) = tab_stock(ligne - 2, 0)
Sheets("STOCK").Range("B1") = "QUANTITE"
Sheets("STOCK").Range("B" & ligne) = tab_stock(ligne - 2, 1)
Next
'Mettre en forme le tableau et figer la première ligne
Rows("1:1").RowHeight = 60
Range("A1:B1").Select
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("B1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
Columns("A:A").ColumnWidth = 20
' Range("A1:B1").Select
' Selection.AutoFilter
'Création du bouton retour à la page d'acceuil
ActiveSheet.Buttons.Add(200, 10, 250, 40).Select
ActiveSheet.Shapes.Range(Array("Button 1")).Select
Selection.Characters.Text = "Revenir à la première page"
With Selection.Characters(Start:=1, Length:=26).Font
.Name = "Calibri"
.FontStyle = "Gras"
.Size = 17
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = True
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
Selection.OnAction = "Accueil"
ActiveWindow.Panes(3).Activate
Range("A2").Select
End With
'Protège lA feuille STOCK
Sheets("STOCK").Protect
End Sub |
Partager