Voilà, dès que je partage par outils etc, je ne peux plus faire aller correctement le programme, soit, ça ne vide pas toutes les cellules comme ci desous en exemple, ou une condition bloque à la 2ème macro ?
et dès que départage le classeur ça fonctionne ?
As tu une idée... merci pour ta réponse Fermo
Sub Vider2()
On Error Resume Next
Application.Run "Z_Bloque"
Sheets("Bulletin de livraison").Select
Application.ScreenUpdating = False
'Demander un choix avant de lancer la macro
votreRéponse = MsgBox("Est-ce que vous voulez vraiment effacer le Bulletin de Livraison ?" _
& (Chr(13)), vbYesNo, "Attention! © Fermo Bonadei août 2003")
If votreRéponse = vbNo Then
Exit Sub
End If
ActiveSheet.Unprotect Password:="3789" ' enlève la protection des cellules
Range("a3").Select
Selection.ClearContents
Range("c19:c29").Select
Selection.ClearContents
Range("b33:b39").Select
Selection.ClearContents
Range("g33:g39").Select
Selection.ClearContents
Range("r33:r39").Select
Selection.ClearContents
Range("s33:s39").Select
Selection.ClearContents
Range("c41").Select
Selection.ClearContents
Range("A15").Select
Range("c18").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("a31").Select 'Copie la formule pour combler les entrées manuelles
Selection.Copy
Range("a33:a39").Select ' colle la formule pour combler les entrées manuelles
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("c31:c31").Select 'Copie la formule pour combler les entrées manuelles
Selection.Copy
Range("c33:c39").Select ' colle la formule pour combler les entrées manuelles
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("i31:j31").Select 'Copie la formule pour combler les entrées manuelles
Selection.Copy
Range("i33:j39").Select ' colle la formule pour combler les entrées manuelles
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("y33:y39").Select 'Copie la formule pour combler les entrées manuelles
Selection.Copy
Range("a33:a39").Select ' colle la formule pour combler les entrées manuelles
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("b41").Select 'Copie la formule pour combler les entrées manuelles
Selection.Copy
Range("c41").Select ' colle la formule pour combler les entrées manuelles
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("a44").Select 'Copie la formule pour combler les entrées manuelles
Selection.Copy
Range("a45").Select ' colle la formule pour combler les entrées manuelles
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
With Application
.Calculation = xlAutomatic ' mais OPTION sur calcul automatique, car elle ce déclenche parfois
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
Sheets("Bulletin de livraison").Select
ActiveSheet.Unprotect Password:="3789" ' enlève la protection des cellules
ActiveSheet.Protect Password:="3789"
ActiveSheet.EnableSelection = xlUnlockedCells 'protège les cellules
Range("c18").Select
End Sub
*****************************************
Sub Livrtoarchive()
On Error Resume Next
Application.ScreenUpdating = False
ContrôleBlt
'Conditions contrôle si le bulletin est archivé
'Sur Blt livraison
If Range("controlearchives") = "1" Then
MsgBox "IMPOSSIBLE, le Bulletin est déjà Archivé!."
Range("controlearchives").Select
Exit Sub
End If
'Conditions Validation
'Sur Date
If Range("Date") = "" Then
MsgBox "Date du Document non renseignée."
Range("Date").Select
Exit Sub
End If
'Sur N°
If Range("Nclient") = "" Then
MsgBox "Numéro client non renseigné."
Range("Nclient").Select
Exit Sub
End If
'Sur Réf
If Range("Réf") = "" Then
MsgBox "Référence non renseigné."
Range("Réf").Select
Exit Sub
End If
'Sur adresse
If Range("c26") = "" Then
MsgBox "Adresse non renseigné."
Range("c26").Select
Exit Sub
End If
'Sur N° Article
If Range("b33") = "" Then
MsgBox "Qté Article non renseigné."
Range("b33").Select
Exit Sub
End If
'Sur Qté Article
If Range("g33") = "" Then
MsgBox "N° Article non renseigné."
Range("g33").Select
Exit Sub
End If
'Sur Nom du collaborateur stratex
If Range("Nomcollaborateurs") = "" Then
MsgBox "Nom du collaborateur stratex, non renseignée."
Range("Nomcollaborateurs").Select
Exit Sub
End If
Sheets("Archive livraison").Select
ActiveSheet.Unprotect Password:="3789" ' enlève la protection des cellules
Sheets("Bulletin de livraison").Activate 'affiche 1 pour repert si facture archivée
ActiveSheet.Unprotect Password:="3789" ' enlève la protection des cellules
Range("controlearchives") = 1
Sheets("Archive livraison").Select
ActiveSheet.Unprotect Password:="3789" ' enlève la protection des cellules
Rows("3:3").Select
'Application.CutCopyMode = False
Selection.Copy
ActiveCell.SpecialCells(xlLastCell).Select
Cells(ActiveCell.Row + 1, 1).Select 'se place à gauche
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Va vider tous les "0"
ActiveCell.Offset(0, 0).Range("A1").Select
For i = 1 To 120
If ActiveCell = "0" Then
Selection.ClearContents
Else
End If
ActiveCell.Offset(0, 1).Range("A1").Select
Next i
'Imprimer Document
'Nbre de copie à imprimer
vNbreImp = InputBox("Nombre d'exemplaire à imprimer :", "Impression Document", 1)
If vNbreImp <= 0 Then GoTo 5
If IsNumeric(vNbreImp) Then
GoTo 10
Else: Do Until IsNumeric(vNbreImp)
5
MsgBox "La valeur doit être un nombre entier et > 0"
vNbreImp = InputBox("Nombre d'exemplaire à imprimer :", "Impression Document", 1)
Loop
GoTo 10
End If
10
Sheets("Bulletin de livraison").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=vNbreImp
GoTo 20
20
Sheets("Bulletin de livraison").Select
ActiveSheet.Unprotect Password:="3789" ' enlève la protection des cellules
Sheets("Bulletin de livraison").Activate
Sheets("Informations Société").Select
ActiveSheet.Unprotect Password:="3789" ' enlève la protection des cellules
'Incrémentation Compteur
Range("vnDocumentNumDoc") = Range("vnDossierNumDoc")
Sheets("Archive livraison").Select
ActiveSheet.Protect Password:="3789"
ActiveSheet.EnableSelection = xlNoRestrictions 'protège les cellules
Sheets("Archive livraison").Select
triéBlt
Sheets("Articles").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, Password:="3789"
Sheets("Bulletin de livraison").Select
ActiveSheet.Protect Password:="3789"
Range("a15").Select
End Sub