'Validation BL
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
'On Error GoTo fin
Dim start As Single
start = Timer
Dim cl As Range, cbl, cbl2, cbl3, cblaa, cbla, cbla1, stock, cel, stockval As Variant, vali As Variant, valtemp As Variant
Dim nouvonglet, nouvonglet2 As String, c As Range, LePath As String, LeNom As String, fichier As String, Dossier As String, Chemin As String, sh As Shape, n As Name
Set cbl = Feuil33.Columns(4).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Find([E8]) 'Numéro de commande en feuille Etat des Commandes
Set cbl2 = Feuil33.Columns(8).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Find([E8]) 'Numéro de commande bis en feuille Etat des Commandes
Set cbl3 = Feuil33.Columns(12).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Find([E8]) 'Numéro de commande bis en feuille Etat des Commandes
Set cblaa = Feuil33.Columns(8).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Find(Feuil30.[H8]) 'Numéro de commande bis du Bl temp en feuille Etat des Commandes
Set cbla1 = Feuil33.Columns(8).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Find(Feuil30.[E8]) 'Numéro de commande bis du Bl temp en feuille Etat des Commandes
Set cl = Sheets("Clients").Columns(2).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Find([B12]) 'Client en feuille Clients
Dim Lg, Lg2 As String
[A:A].ClearContents
'Vérification du stock
For Each cel In Range("C20:C53, C83:C116")
Set stock = Feuil24.Columns(3).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Find(cel) 'stock = référence en feuille stock
If stock Is Nothing Then GoTo suite
If stock.Offset(, 6) < 1 Then cel.Offset(, -2) = "x" 'si stock est inférieur à 1 alors mettre un x en colonne A
Next cel
suite:
If [H12] = "Livraison Partielle " Then GoTo Bltemp
'cbl = équivalent BL de la commande en feuille Etat des commandes
If Application.CountIf([E8], "*bis") Then
If cbla1.Offset(, 6) <> "" Then
MsgBox ("BL 3 déjà existant !")
Exit Sub
End If
If cbla1.Offset(, 2) <> "" Then
MsgBox ("BL 2 déjà existant !")
Exit Sub
Else: GoTo continue
End If
ElseIf Application.CountIf([E8], "*ter") Then
If cblaa.Offset(, 6) <> "" Then
MsgBox ("BL 3 déjà existant !")
Exit Sub
Else: GoTo continue
End If
'cbl.Offset(, 2) <> "" Then
MsgBox ("BL déjà existant !")
'End If
Exit Sub
End If
continue:
If MsgBox("Pensé à changer de client ?", vbYesNo) = vbNo Then
Exit Sub
End If
With [B12] 'cl = B12 (client) en feuille client
.Offset(1, 0) = cl.Offset(0, 1) & " " & cl.Offset(0, 2)
.Offset(2, 0) = cl.Offset(0, 4)
.Offset(3, 0) = cl.Offset(0, 5)
.Offset(3, 1) = cl.Offset(0, 6)
.Offset(-7, 5) = cl.Offset(0, -1)
End With
' Numérotation du BL et de la date
[J9] = [J9] + 1
[E5] = "BL N° " & [J9]
[F5] = Date
Application.ScreenUpdating = True
If [G5] <> [G8] Then
If MsgBox("2 codes client différents ? Etes vous sûr de continuer ?", vbYesNo) = vbNo Then 'Retour en arrière
[J9] = [J9] - 1
[E5] = "BL N° " & [J9]
Exit Sub
End If
End If
If MsgBox("Données mises à jour. Continuer ?", vbYesNo) = vbNo Then 'Retour en arrière
[J9] = [J9] - 1
[E5] = "BL N° " & [J9]
Exit Sub
End If
Application.ScreenUpdating = False
'Modification du 9.06.16
'Remplissage Feuile Stock
Dim cherch As Range, sto As Range, mvsto As Range
On Error Resume Next
For Each cherch In Range("C20:C53, C83:C116") 'cherch sont les cellules colonne C (Désignation)
If Not IsEmpty(Range("C20:C53, C83:C116")) Then
Set sto = Feuil24.Columns(3).Find(cherch) 'sto sont les références recherchées dans la feuille Stock
sto.Offset(0, 5) = sto.Offset(0, 5) + cherch.Offset(0, 2).Value
'sto.Offset(0, 10) = cherch.Offset(0, 5).Value
End If
'Next
'Remplissage Feuile Mvts Stock
' For Each cherch In Range("C20:C53, C83:C116")
If Not IsEmpty(Range("C20:C53, C83:C116")) Then
If IsEmpty(cherch) Then GoTo suite2
Set mvsto = Feuil3.Columns(5).Find(cherch) 'mvsto sont les références recherchées dans la feuille Produits
With Feuil29
.Range("B30000").End(xlUp).Offset(1, 0) = [F5]
.Range("B30000").End(xlUp).Offset(0, 1) = cherch
.Range("B30000").End(xlUp).Offset(0, 6) = cherch.Offset(0, 2).Value
'.Range("B30000").End(xlUp).Offset(0, 18) = cherch.Offset(0, 5).Value
.Range("B30000").End(xlUp).Offset(0, 2) = mvsto.Offset(0, -1)
.Range("B30000").End(xlUp).Offset(0, 3) = mvsto.Offset(0, -2)
.Range("B30000").End(xlUp).Offset(0, 4) = [B12]
End With
End If
Next
suite2:
'Fin de modif
'Remplissage de la feuille Etat des commandes
With Feuil33
On Error Resume Next
If cbl.Offset(, 2) = "" Then
cbl.Offset(, 1) = [F5]
cbl.Offset(, 2) = [E5]
End If
If cbl2.Offset(, 2) = "" Then
cbl2.Offset(, 1) = [F5]
cbl.Offset(, 2) = [E5]
cbl.Offset(, 8) = [M8]
End If
If cbl3.Offset(, 10) = "" Then
cbl3.Offset(, 1) = [F5]
cbl3.Offset(, 2) = [E5]
'Numéro de commande bis
'cbl.Offset(, 4) = [M8]
End If
If Feuil30.[H12] = "" Then cbl.Offset(, 14) = "Fini"
If cbl2.Offset(, -2) = "" Then
cbl2.Offset(, 1) = [F5]
cbl2.Offset(, 2) = [E5]
ElseIf cbl2.Offset(, 2) = "" Then
cbl2.Offset(, 1) = [F5]
cbl2.Offset(, 2) = [E5]
ElseIf cbl2.Offset(, 6) = "" Then
cbl2.Offset(, 5) = [F5]
cbl2.Offset(, 6) = [E5]
End If
If Feuil30.[H12] = "" Then cbl2.Offset(, 10) = "Fini"
If Feuil30.[H12] = "" Then cbl3.Offset(, 6) = "Fini"
End With
'Appeler. Inscription des numéros dans les feuilles BL et Facture
Index_BL
'Enregistrement dans le Classeur de Livraisons-----------------------------------------------------------
' On Error GoTo fin2
'Dim nouvonglet As String, c As Range, LePath As String, LeNom As String, fichier As String, Dossier As String, Chemin As String, sh As Shape, n As Name
nouvonglet = [E5]
Cells.Copy
On Error Resume Next
Workbooks("Historique Bons de Livraison Delicacy 2016.xlsx").Activate
If Err.Number <> 0 Then
Workbooks.Open ("C:\Users\Largo\Documents\0 Travail\Autre\Delicacy\0 Gestion\Clients\Archives\Historique Bons de Livraison Delicacy 2016.xlsx")
End If
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = nouvonglet
ActiveSheet.Paste
ActiveWindow.Zoom = 80
'Columns("N:X").Delete
For Each sh In ActiveSheet.Shapes
sh.Delete
Next
For Each n In ActiveWorkbook.Names
n.Delete
Next n
For Each c In ActiveSheet.[A1:P132].SpecialCells(xlCellTypeFormulas, 23)
c.Value = c.Value
Next
ActiveSheet.Columns("J:AF").Delete
ActiveSheet.[B1].Select
ActiveWorkbook.Close True
MsgBox ("Sauvegarde effectuée.")
'Enregistrement du Pdf----------------------------------------------------------------------------------
If [C83] <> "" Then
Range("B1:H120").Select
Else
Range("B1:H56").Select
End If
With ActiveSheet
fichier = "\" & Range("B12") & " " & [E5] & " du " & Format([F5], "ddmmyyyy") & ".pdf"
Dossier = "C:\Users\Largo\Documents\0 Travail\Autre\Delicacy\0 Gestion\Clients\BL"
Chemin = Dossier & fichier
End With
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
Range("I18").Select
Exit Sub
Bltemp: '--------------------------------------------------------------------------------------------------------------------
'Vérification de l'existance des BL
If [H8] = "" Then
On Error Resume Next
If cbl.Offset(, 9) <> "" Then
MsgBox ("BL 3 déjà existant !")
Exit Sub
End If
If cbl.Offset(, 6) <> "" Then
MsgBox ("BL 2 déjà existant !")
Exit Sub
End If
If cbl.Offset(, 2) <> "" Then
MsgBox ("BL déjà existant !")
Exit Sub
End If
Else
'Modif
If Application.CountIf([E8], "*ter") Then
If cbla.Offset(, 6) = "" Then GoTo derbl
'Else: MsgBox ("BL 3 déjà existant !")
'Exit Sub
End If
'If cbla.Offset(, 2) <> "" Then
'MsgBox ("BL 2 déjà existant !")
'Exit Sub
'Else: GoTo continue
'End If
End If
'fin modif
If Not cbl2 Is Nothing Then
If cbl2.Offset(, 6) <> "" Then
MsgBox ("BL 3 déjà existant !")
Exit Sub
End If
If cbl2.Offset(, 2) <> "" Then
MsgBox ("BL 2 déjà existant !")
Exit Sub
End If
End If
derbl:
'Remplissage coordonnées en feuille BL Temp
Feuil34.[B12] = [B12]
Feuil34.[B13] = [B13]
Feuil34.[B14] = [B14]
Feuil34.[B15] = [B15]
Feuil34.[C15] = [C15]
Feuil34.[G5] = [G5]
Feuil34.[E8] = [E8]
Feuil34.[F8] = [F8]
Feuil34.[G8] = [G8]
Feuil34.[H8] = [E8]
' Numérotation du nouveau BL et de la date
[J9] = [J9] + 1
[E5] = "BL N° " & [J9]
Feuil34.[E5] = [E5] & " P" 'P pour Partiel
Feuil34.[F5] = Date
'Vidage des anciennes commandes colonnes C et K
Feuil34.Range("C20:E60, K20:M60").ClearContents
'Remplissage des données du nouveau BL
Lg = Feuil34.Range("C61").End(xlUp).Row + 1
If Lg = 19 Then Lg = 20
Lg2 = Feuil34.Range("K61").End(xlUp).Row + 1
If Lg2 = 19 Then Lg2 = 20
Dim df As Range
'Modification du 2.06.16
For Each cel In Range("C20:C54, C83:C116")
If IsEmpty(cel) Then GoTo rempstock
Set stockval = Feuil24.Columns(3).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Find(cel).Offset(, 6) 'stockval = quantité en feuille stock
Set vali = cel.Offset(, 2) 'quantité en BL
If cel.Offset(, -2) = "" And cel <> "" Then
Feuil34.Range("C" & Lg) = cel
If vali > stockval Then
Feuil34.Range("E" & Lg) = vali - stockval
Set df = Feuil34.Range("E" & Lg)
Set valtemp = vali - df
Feuil34.Range("K" & Lg2) = cel
Feuil34.Range("M" & Lg2) = valtemp
Lg2 = Lg2 + 1
Else
Feuil34.Range("E" & Lg) = vali
End If
'Feuil31.Range("F" & Lg) = cel.Offset(, -1)
Lg = Lg + 1
Else
If cel.Offset(, -2) <> "" And cel <> "" Then
Feuil34.Range("K" & Lg2) = cel
Feuil34.Range("M" & Lg2) = cel.Offset(, 2)
'Feuil31.Range("F" & Lg) = cel.Offset(, -1)
Lg2 = Lg2 + 1
End If
End If
Next
rempstock: