3
Private Sub CleanImports()
shCommande.Cells.Replace What:=",", Replacement:=".", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
shOF.Cells.Replace What:=",", Replacement:=".", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
shOA.Range("A:IV").Cells.Replace What:=",", Replacement:=".", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
shCommande.Cells.Replace What:=Chr(160), Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
shOF.Cells.Replace What:=Chr(160), Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
shOA.Range("A:IV").Cells.Replace What:=Chr(160), Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
End Sub
Private Sub MakeSynthese()
Application.ScreenUpdating = False
Dim restants() As QteStock 'tableau du stock restant pour chaque article lu
Dim articlesLus As Integer 'nombre d'articles lus
Dim stockTheo As Long
Dim nbOF As Integer
Dim nbOA As Integer
Dim ligneRes As Long, ligneCmd As Long
Dim col As Integer
Dim ensemble As String, projet As String, article As String
Dim lastEnsemble As String, lastProjet As String, lastArticle As String
ReDim restants(shCommande.Range("A:A").End(xlDown).Row)
With shSynthese
.Activate
With .Range("A:IV")
'Effacement des bordures sur la feuille
.Borders.LineStyle = xlLineStyleNone
'couleur de cellules : gris
.Interior.Pattern = xlPatternNone
.Interior.Color = RGB(192, 192, 192)
.ClearContents
.Font.Color = RGB(0, 0, 0)
.Font.Bold = False
End With '.Range ("A:IV")
.Range("A1:AG1") = Array("Date", "Cde", "Client", "Nom", "Lg", "Projet", "Code article", "Description", "Qté cdée", "A livrer", _
"Code article", "Description", "Besoin", "Sto phy", "Sto cde", "Sto rés", "Sto théo", "Livr", "OF", "Qté plan", " Qté réal", "Opé", " CC", "Description", "Tps all", " Temps pass", "Délai", "Retard", _
"N° ordre", "Fourn", "pos", "Qté rest", "Récept")
.Range("A1:AG1").Font.Bold = True
.Range("A1:J1").Interior.Color = RGB(0, 0, 255)
.Range("A1:J1").Font.Color = RGB(255, 255, 255)
.Range("K1:Q1").Interior.Color = RGB(255, 255, 128)
.Range("R1:AB1").Interior.Color = RGB(255, 192, 128)
.Range("AC1:AG1").Interior.Color = RGB(192, 255, 128)
Call AnnulerFusionCellules
End With
'nb de ligne ds la feuille finale
ligneRes = 2
ensemble = "aaaaaaaaaaaaaaaaa"
projet = "aaaaaaaaaaaaaaaaaaa"
article = ""
'Pour chaque commande
articlesLus = 0 'on n'a détecté aucun article
ligneCmd = 6 '1ère ligne du carnet de commandes à prendre en compte
With shSynthese
While shCommande.Cells(ligneCmd, 1) <> ""
'ligneRes = ligneRes + 1
lastEnsemble = ensemble
lastProjet = projet
lastArticle = article
ensemble = shCommande.Cells(ligneCmd, 7)
projet = shCommande.Cells(ligneCmd, 6)
article = shCommande.Cells(ligneCmd, 12)
'si la ligne correspond à un nouvel article on l'affiche
If ensemble <> lastEnsemble Or projet <> lastProjet And (projet <> "" Or lastProjet <> "") Then
'Si ni OA ni OF pour l'article précédent trouvés
If .Cells(ligneRes, 1) <> "" Then
'si la pièce est prête
If .Cells(ligneRes, 17) = "" Then
With .Range("A" & ligneRes & ":Q" & ligneRes)
If .Cells(1, 9).Value = .Cells(1, 10).Value Then
.Interior.Color = RGB(192, 255, 128) 'ligne sans OF ni OA en vert
Else
.Interior.Color = RGB(255, 255, 0) 'gestion des reliquats en jaune
shSynthese.Range("K" & ligneRes & ":Q" & ligneRes).Merge
.Cells(1, 11).Value = "En attente de décision (confirmation des reliquats)"
End If
.Font.Bold = True
End With
End If
ligneRes = ligneRes + 1 'saut de ligne pour ne pas écraser l'ensemble vide
End If
For col = 1 To 10
.Cells(ligneRes, col).Value = shCommande.Cells(ligneCmd, col).Value
Next col
'bordure épaisse :
.Range("A" & ligneRes & ":AG" & ligneRes).Borders(xlEdgeTop).Weight = xlThick
End If
If article <> "" Then
'si le stock ne suffit pas
stockTheo = CheckStocks(restants, articlesLus, article, shCommande.Cells(ligneCmd, 14).Value, shCommande.Cells(ligneCmd, 15).Value, CDate(shCommande.Cells(ligneCmd, 1).Value))
If stockTheo < 0 Then
.Cells(ligneRes, 17).Value = stockTheo
Call CopyOF(projet, article, ligneRes, nbOF)
Call CopyOA(projet, article, ligneRes, nbOA)
If article <> lastArticle Or ensemble <> lastEnsemble Then
.Cells(ligneRes, 11) = article
End If
'quantités (à livrer, stock, en commande, en réserve
For col = 13 To 17
.Cells(ligneRes, col - 1).Value = shCommande.Cells(ligneCmd, col).Value
Next col
If (nbOA > nbOF) Then nbOF = nbOA
If (nbOF > 0) Then
.Range("A" & ligneRes & ":Q" & ligneRes + nbOF - 1).Interior.Color = RGB(255, 255, 255)
ligneRes = ligneRes + nbOF
Else
With .Range("A" & ligneRes & ":Q" & ligneRes)
.Font.Color = RGB(255, 255, 255)
.Font.Bold = True
.Interior.Color = RGB(192, 0, 0)
.Interior.Pattern = xlPatternGray8
End With
ligneRes = ligneRes + 1
End If
'sinon, le stock suffit
Else
End If
End If
ligneCmd = ligneCmd + 1
Wend
If nbOF > 0 Then
' ligneRes = ligneRes - 1
End If
If ensemble = lastEnsemble And .Cells(ligneRes, 1) = "" Then
ligneRes = ligneRes - 1
Else
'éventuellement la dernière ligne est un ensemble vide, auquel cas on la colore en vert
If .Cells(ligneRes, 17) = "" Then
With .Range("A" & ligneRes & ":Q" & ligneRes)
.Interior.Color = RGB(192, 255, 128) 'ligne sans OF ni OA en vert
.Font.Bold = True
End With
End If
End If
.Range("A2:AG" & ligneRes).Borders(xlInsideVertical).Weight = xlThin
End With
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = "$A$1:$AG$" & ligneRes
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "&""Arial,Gras""&14CARNET DE COMMANDES ET MANQUANTS" _
& " du " & shCommande.Range("C3").Value & " au " & shCommande.Range("C4").Value _
& Chr(10) & "Horizon des OF et OA: " & shOF.Range("C2").Value
.RightHeader = "&D"
.LeftFooter = ""
.CenterFooter = "Page &P de &N"
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.393700787401575)
.RightMargin = Application.InchesToPoints(0.354330708661417)
.TopMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.984251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 70
.PrintErrors = xlPrintErrorsDisplayed
End With
Application.ScreenUpdating = True
End Sub