I am trying to run a VBA code by pressing the button "Complete the Hazard Control selection"; however, there is an error in the code, as seen in the first image. The second image is of the section of the code that the error occurs. Below is also the full code copied and pasted (in French and some parts in English). Can someone please help me?
Code:
'CE MODULE EST UTILISÉ À PARTIR DE LA FEUILLE ANALYSE DE RISQUE
'LORSQUE LE BOUTON "EFFACER LES TÂCHES NON APPLICABLES EST CLIQUÉ, C'EST CETTE MACRO QUI EST APPELÉ
Dim lig_ana, lig_mat, lig_ctrl_temp, lig_ctrl, lig_ins, lig_for, lig_epi, lig_ava As Double
Sub ensemble_tâche_pour_populer_moyens_de_contrôle()
Application.ScreenUpdating = False
Call effaçage_tâches_non_applicable
Sheets("ctrl_temp").Activate 'efface les données de la feuille ctrl temp
Call efface_feuille_ctrl
Sheets("Hazard Control").Activate 'efface les données de la feuille moyens de contrôle
Call efface_feuille_ctrl
Cells(1, 16384) = 0 'remet à zéro la valeur de l'indicateur de présence d'EPI lunettes, casque et bottes
Cells(2, 16384) = 0 'sert pour la case à cocher ASP pour faire aparaître et disparaître au besoin seulement
Cells(3, 16384) = 0
Call copie_EPI_dans_temp 'copie les EPI dans la feuille de contrôle temporaire
Call tri_val_dans_temp 'fait le tri des EPI dans la feuille temporaire, efface les doublons et copie dans la feuille finale
Call reperage_derniere_ligne_ecrite 'repère la dernière cellule écrite de chacune des colonnes
Call gestion_cas_particulier 'fait l'ajout de case à cocher en fonction de certains dangers ou mots clés présents dans "matrice globale"
Call gestion_case_ASP_Construction 'on ajoute au besoin des EPI si la case ASP construction a été cochée
End Sub
Sub effaçage_tâches_non_applicable() 'efface les tâches sélectionnées comme étant non valide
'doit aussi aller effacer le x dans la feuille "matrice globale"
lig = 14
While Cells(lig, 1) <> ""
If Cells(lig, 17) <> "" Then
Rows(lig & ":" & lig).Select
Selection.Delete Shift:=xlUp
lig = lig - 1
End If
lig = lig + 1
Wend
End Sub
Sub efface_feuille_ctrl() 'efface toutes les checkbox sauf la 1 et la 2, efface le contenu
'des cellules
Dim ole As OLEObject
Dim cb As CheckBox
For Each cb In ActiveSheet.CheckBoxes
ChkBoxRow = cb.TopLeftCell.Row
ChkBoxCol = cb.TopLeftCell.Column
If ChkBoxRow = 6 Or ChkBoxRow = 7 Then
If ChkBoxCol = 3 Or ChkBoxCol = 4 Then
GoTo ne_pas_effacer
End If
End If
cb.Delete
ne_pas_effacer:
Next cb
Range("A6:U150").Select 'efface les valeurs de la feuille
Selection.ClearContents
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
Sub copie_EPI_dans_temp()
Sheets("Risk Assessment").Activate
lig_ana = 14
lig_mat = 6
lig_ins = 6
lig_for = 8
lig_epi = 6
lig_ava = 6
lig_ctrl = 6
While Cells(lig_ana, 26) <> ""
num_tâche = Cells(lig_ana, 26) 'détection du numéro de tâche
While ActiveWorkbook.Worksheets("Global Risk Assessment Matrix").Cells(lig_mat, 26) <> num_tâche 'recherce dans la feuille matrice globale
lig_mat = lig_mat + 1
Wend
instructions = ActiveWorkbook.Worksheets("Global Risk Assessment Matrix").Cells(lig_mat, 20)
formation = ActiveWorkbook.Worksheets("Global Risk Assessment Matrix").Cells(lig_mat, 21)
EPI = ActiveWorkbook.Worksheets("Global Risk Assessment Matrix").Cells(lig_mat, 22)
autre_equip = ActiveWorkbook.Worksheets("Global Risk Assessment Matrix").Cells(lig_mat, 23)
avant_debut = ActiveWorkbook.Worksheets("Global Risk Assessment Matrix").Cells(lig_mat, 24)
note_spéciale = ActiveWorkbook.Worksheets("Global Risk Assessment Matrix").Cells(lig_mat, 25)
If instructions <> "" Then
Call gestion_val_mult_instr(instructions) 'sert à copier les différents items et à gérer la présence de la "," comme indicateur de
End If 'plus d'un valeur dans instructions ou formation ou etc...
If formation <> "" Then
Call gestion_val_mult_formation(formation)
End If
If EPI <> "" Then
Call gestion_val_mult_epi(EPI)
End If
If autre_equip <> "" Then
Call gestion_val_mult_autre_equip(autre_equip)
End If
If avant_debut <> "" Then
Call gestion_val_mult_avant_debut(avant_debut)
End If
lig_mat = 6
lig_ana = lig_ana + 1
Wend
End Sub
Sub gestion_val_mult_instr(instructions)
long_car = Len(instructions)
i = 1
While i <= long_car
i_deb = i
While Mid(instructions, i, 1) <> "," And i <= long_car
i = i + 1
Wend
i_fin = i
valeur = Mid(instructions, i_deb, (i_fin - i_deb))
ActiveWorkbook.Worksheets("ctrl_temp").Cells(lig_ins, 1) = valeur
lig_ins = lig_ins + 1
i = i + 2
Wend
End Sub
Sub gestion_val_mult_formation(formation)
long_car = Len(formation)
i = 1
While i <= long_car
i_deb = i
While Mid(formation, i, 1) <> "," And i <= long_car
i = i + 1
Wend
i_fin = i
valeur = Mid(formation, i_deb, (i_fin - i_deb))
ActiveWorkbook.Worksheets("ctrl_temp").Cells(lig_for, 3) = valeur
lig_for = lig_for + 1
i = i + 2
Wend
End Sub
Sub gestion_val_mult_epi(EPI)
long_car = Len(EPI)
i = 1
While i <= long_car
i_deb = i
While Mid(EPI, i, 1) <> "," And i <= long_car
i = i + 1
Wend
i_fin = i
valeur = Mid(EPI, i_deb, (i_fin - i_deb))
ActiveWorkbook.Worksheets("ctrl_temp").Cells(lig_epi, 16) = valeur
lig_epi = lig_epi + 1
i = i + 2
Wend
End Sub
Sub gestion_val_mult_autre_equip(autre_equip)
long_car = Len(autre_equip)
i = 1
While i <= long_car
i_deb = i
While Mid(autre_equip, i, 1) <> "," And i <= long_car
i = i + 1
Wend
i_fin = i
valeur = Mid(autre_equip, i_deb, (i_fin - i_deb))
ActiveWorkbook.Worksheets("ctrl_temp").Cells(lig_epi, 19) = valeur
lig_epi = lig_epi + 1
i = i + 2
Wend
End Sub
Sub gestion_val_mult_avant_debut(avant_debut)
long_car = Len(avant_debut)
i = 1
While i <= long_car
i_deb = i
While Mid(avant_debut, i, 1) <> "," And i <= long_car
i = i + 1
Wend
i_fin = i
valeur = Mid(avant_debut, i_deb, (i_fin - i_deb))
ActiveWorkbook.Worksheets("ctrl_temp").Cells(lig_ava, 21) = valeur
lig_ava = lig_ava + 1
i = i + 2
Wend
End Sub
Sub tri_val_dans_temp() 'tri les valeurs dans chaque colonne puis efface les doublons
'fait l'ajustement des hauteurs de ligne
Dim ligne_max_ajustement As Integer
Dim tab_valeur(500) As String
ligne_max_ajustement_premier = 8
ligne_max_ajustement = ligne_max_ajustement_premier
Sheets("ctrl_temp").Select
'lig_ins = lig_ins - 1
'lig_for = 8
'lig_epi = 6
'lig_ava = 6
'lig_ctrl = 6
Range("A6:B" & lig_ins).Select 'tri de la colonne A instruction
ActiveWorkbook.Worksheets("ctrl_temp").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ctrl_temp").Sort.SortFields.Add Key:=Range( _
"A6:A" & lig_ins), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("ctrl_temp").Sort
.SetRange Range("A6:B" & lig_ins)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
lig = 6 'effaçage des doublons
col = 1
i = 0
valeur = Cells(lig, col)
val_suiv = Cells(lig + 1, col)
While Cells(lig, col) <> ""
While val_suiv = valeur And Cells(lig, col) <> ""
lig = lig + 1
val_suiv = Cells(lig, col)
Wend
If Cells(lig, col) <> "" Then 'si on a trouvé une valeur différente
valeur = Cells(lig, col)
tab_valeur(i) = valeur
i = i + 1
lig = lig + 1
val_suiv = Cells(lig, col)
End If
Wend
i_max = i - 1
If lig = 6 Then
GoTo rien_a_copier1
End If
Sheets("Hazard Control").Select
lig = 6
i = 0
col = 1
While i <= i_max
Cells(lig, col) = tab_valeur(i)
i = i + 1
lig = lig + 1
Wend
Erase tab_valeur()
If lig - 1 > ligne_max_ajustement Then 'valide si on a dépassé la ligne_max où on ajuste
ligne_max_ajustement = lig 'la hauteur, si oui on change la valeur
End If
rien_a_copier1:
Sheets("ctrl_temp").Select
Range("C8:I" & lig_for).Select 'tri de la colonne C formation
ActiveWorkbook.Worksheets("ctrl_temp").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ctrl_temp").Sort.SortFields.Add Key:=Range( _
"C8:C" & lig_for), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("ctrl_temp").Sort
.SetRange Range("C8:I" & lig_for)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
lig = 8
col = 3 'effaçage des doublons
i = 0
valeur = Cells(lig, col)
val_suiv = Cells(lig + 1, col)
While Cells(lig, col) <> ""
While val_suiv = valeur And Cells(lig, col) <> ""
lig = lig + 1
val_suiv = Cells(lig, col)
Wend
If Cells(lig, col) <> "" Then 'si on a trouvé une valeur différente
valeur = Cells(lig, col)
tab_valeur(i) = valeur
i = i + 1
lig = lig + 1
val_suiv = Cells(lig, col)
End If
Wend
i_max = i - 1
If lig = 8 Then
GoTo rien_a_copier2
End If
Sheets("Hazard Control").Select
lig = 8
i = 0
col = 3
While i <= i_max
Cells(lig, col) = tab_valeur(i)
i = i + 1
lig = lig + 1
Wend
Erase tab_valeur()
If lig - 1 > ligne_max_ajustement Then 'valide si on a dépassé la ligne_max où on ajuste
ligne_max_ajustement = lig 'la hauteur, si oui on change la valeur
End If
rien_a_copier2:
Sheets("ctrl_temp").Select
Range("P6:R" & lig_epi).Select 'tri de la colonne P EPI
ActiveWorkbook.Worksheets("ctrl_temp").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ctrl_temp").Sort.SortFields.Add Key:=Range( _
"P6:P" & lig_epi), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("ctrl_temp").Sort
.SetRange Range("P6:R" & lig_epi)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
lig = 6
col = 16
i = 0
valeur = Cells(lig, col)
val_suiv = Cells(lig + 1, col)
While Cells(lig, col) <> ""
While val_suiv = valeur And Cells(lig, col) <> ""
lig = lig + 1
val_suiv = Cells(lig, col)
Wend
If Cells(lig, col) <> "" Then 'si on a trouvé une valeur différente
valeur = Cells(lig, col)
tab_valeur(i) = valeur
i = i + 1
lig = lig + 1
val_suiv = Cells(lig, col)
End If
Wend
i_max = i - 1
If lig = 6 Then
GoTo rien_a_copier3
End If
Sheets("Hazard Control").Select
lig = 6
i = 0
col = 16
While i <= i_max
Cells(lig, col) = tab_valeur(i)
i = i + 1
lig = lig + 1
Wend
Erase tab_valeur()
If lig - 1 > ligne_max_ajustement Then 'valide si on a dépassé la ligne_max où on ajuste
ligne_max_ajustement = lig 'la hauteur, si oui on change la valeur
End If
rien_a_copier3:
Sheets("ctrl_temp").Select
Range("S6:T" & lig_epi).Select 'tri de la colonne S Autres équipements
ActiveWorkbook.Worksheets("ctrl_temp").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ctrl_temp").Sort.SortFields.Add Key:=Range( _
"S6:S" & lig_epi), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("ctrl_temp").Sort
.SetRange Range("S6:T" & lig_epi)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
lig = 6
col = 19
i = 0
valeur = Cells(lig, col)
val_suiv = Cells(lig + 1, col)
While Cells(lig, col) <> ""
While val_suiv = valeur And Cells(lig, col) <> ""
lig = lig + 1
val_suiv = Cells(lig, col)
Wend
If Cells(lig, col) <> "" Then 'si on a trouvé une valeur différente
valeur = Cells(lig, col)
tab_valeur(i) = valeur
i = i + 1
lig = lig + 1
val_suiv = Cells(lig, col)
End If
Wend
i_max = i - 1
If lig = 6 Then
GoTo rien_a_copier4
End If
Sheets("Hazard Control").Select
lig = 6
i = 0
col = 19
While i <= i_max
Cells(lig, col) = tab_valeur(i)
i = i + 1
lig = lig + 1
Wend
Erase tab_valeur()
If lig - 1 > ligne_max_ajustement Then 'valide si on a dépassé la ligne_max où on ajuste
ligne_max_ajustement = lig 'la hauteur, si oui on change la valeur
End If
rien_a_copier4:
Sheets("ctrl_temp").Select
Range("U6:X" & lig_ava).Select 'tri de la colonne U à vérifier avant le début des travaux
ActiveWorkbook.Worksheets("ctrl_temp").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ctrl_temp").Sort.SortFields.Add Key:=Range( _
"U6:U" & lig_ava), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("ctrl_temp").Sort
.SetRange Range("U6:X" & lig_ava)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
lig = 6
col = 21
i = 0
valeur = Cells(lig, col)
val_suiv = Cells(lig + 1, col)
While Cells(lig, col) <> ""
While val_suiv = valeur And Cells(lig, col) <> ""
lig = lig + 1
val_suiv = Cells(lig, col)
Wend
If Cells(lig, col) <> "" Then 'si on a trouvé une valeur différente
valeur = Cells(lig, col)
tab_valeur(i) = valeur
i = i + 1
lig = lig + 1
val_suiv = Cells(lig, col)
End If
Wend
i_max = i - 1
If lig = 6 Then
GoTo rien_a_copier5
End If
Sheets("Hazard Control").Select
lig = 6
i = 0
col = 21
While i <= i_max
Cells(lig, col) = tab_valeur(i)
i = i + 1
lig = lig + 1
Wend
Erase tab_valeur()
If lig - 1 > ligne_max_ajustement Then 'valide si on a dépassé la ligne_max où on ajuste
ligne_max_ajustement = lig 'la hauteur, si oui on change la valeur
End If
rien_a_copier5:
lig = ligne_max_ajustement_premier
While lig < ligne_max_ajustement
Range("A" & lig & ":U" & lig).EntireRow.AutoFit
lig = lig + 1
Wend
End Sub
Sub reperage_derniere_ligne_ecrite()
Sheets("Hazard Control").Select 'recherche des dernières cellules d'EPI et d'autres équipements
lig = 6 'servira pour ajouter les cases à cocher où lorsqu'on coche "ASP Construction" et
'et qu'on doit ajouter d'autres EPIE
col = 16
While Cells(lig, col) <> ""
lig = lig + 1
Wend
Cells(4, 16384) = lig
lig = 6
col = 19
While Cells(lig, col) <> ""
lig = lig + 1
Wend
Cells(5, 16384) = lig
End Sub
Sub gestion_case_ASP_Construction() 'même code que le "private sub" de la feuille Moyens de contrôle
Sheets("Hazard Control").Select
Cells(6, 1).Select
dern_lig = Cells(4, 16384) 'valeur de la ligne à laquelle on doit ajouter les EPI
If Cells(6, 16384) = "VRAI" Then 'ajout des EPI quand la case est cochée
lig = 6
col = 16
While Cells(lig, col) <> "" 'on valide si les 3 EPI sont déjà présents dans la liste des EPI requis
'If Cells(lig, col) = "High visibility vest" Then 's'ils le sont on indique la valeur à 1, sinon la valeur reste à 0
' Cells(1, 16384) = 1
'End If
If Cells(lig, col) = "Steel toe boots" Then
Cells(2, 16384) = 1
End If
If Cells(lig, col) = "Hard hat" Then
Cells(3, 16384) = 1
End If
lig = lig + 1
Wend
lig = dern_lig
'If Cells(1, 16384) = 0 Then 'si l'indicateur est à zéro alors on doit l'ajouter
' Cells(lig, col) = "High visibility vest"
' lig = lig + 1
' Cells(4, 16384) = Cells(4, 16384) + 1 'si on ajoute une ligne on doit faire +1 pour l'indicateur de dernière ligne
'End If
If Cells(2, 16384) = 0 Then 'si l'indicateur est à zéro alors on doit l'ajouter
Cells(lig, col) = "Steel toe boots"
lig = lig + 1
Cells(4, 16384) = Cells(4, 16384) + 1 'si on ajoute une ligne on doit faire +1 pour l'indicateur de dernière ligne
End If
If Cells(3, 16384) = 0 Then 'si l'indicateur est à zéro alors on doit l'ajouter
Cells(lig, col) = "Hard hat"
lig = lig + 1
Cells(4, 16384) = Cells(4, 16384) + 1 'si on ajoute une ligne on doit faire +1 pour l'indicateur de dernière ligne
End If
End If
End Sub
Sub gestion_cas_particulier()
Call zzz_cas_particulier_EPI_Variable 'se trouve dans le module 5
Call zzz_cas_particulier_Autres_equipement_espace_clos 'se trouve dans le module 5
Call zzz_cas_particulier_protection_oculaire 'se trouve dans le module 5
Call zzz_cas_particulier_protection_respiratoire 'se trouve dans le module 5
Call zzz_cas_particulier_travail_hauteur 'se trouve dans le module 5
End Sub
Accepted Solutions