Macro qui ne fonctionne pas en mode feuille protégé
Bonjour
Lorsque je met un fichier en mode protégé et que j'active une macro, Une boite de debogage s'affiche avec le message suivant: "Erreur d'exécution 1004:
Erreur défini par l'application ou par l'objet"
Est-il possible de faire en sorte que ce message ne s'affiche pas et de demeurer en mode feuille protégé.
Voici le code de la macro incrimine
Private Const feuilleTravail As String = "Fiche de travail vehicule leger"
Private Const feuilleSauvegarde As String = "Histo"
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Rows.Count <> 1 Or Target.Columns.Count <> 1 Then Exit Sub
If Target.Column <> 17 Or Target.Row < 8 Or Target.Value = "" Then Exit Sub
col = Target.Row
Select Case Target.Value
Case "Complété"
lettre = "T"
Range(lettre & col).Select
If Range(lettre & col) = "" Then Range(lettre & col) = Now
Selection.Locked = True
Selection.FormulaHidden = False
Case "En Cours"
lettre = "S"
Range(lettre & col).Select
If Range(lettre & col) = "" Then Range(lettre & col) = Now
Selection.Locked = True
Selection.FormulaHidden = False
Case "En Attente"
lettre = "S"
Range(lettre & col).Select
If Range(lettre & col) = "" Then Range(lettre & col) = Now
Selection.Locked = True
Selection.FormulaHidden = False
Case "Libéré"
Dim transfert As Variant
Dim derniereLigne%
derniereLigne = Sheets(feuilleSauvegarde).Cells(Sheets(feuilleSauvegarde).Rows.Count, "A").End(xlUp).Row
transfert = Sheets(feuilleTravail).Range("B" & col & ":W" & col)
Sheets(feuilleSauvegarde).Range("A" & derniereLigne + 1).Resize(1, UBound(transfert, 2) - LBound(transfert, 1) + 2) = transfert
Sheets(feuilleTravail).Range("H" & col).ClearContents
Sheets(feuilleTravail).Range("Q" & col & ":T" & col).ClearContents
End Select
End Sub
Merci
Bonjour bigari,
Pour faire simple:
Si ta macro fonctionne lorsque ta feuille n'est pas protégée, et qu'elle te génère cette erreur lorsqu'elle est protégée, c'est simplement qu'elle réalise des actions interdites par la protection de la feuille. Par exemple si tu interdits la modification de la cellule A1 (en protégeant ta feuille), et que ta macro elle tente d'écrire quelquechose dans la cellule A1 -> refusé -> erreur -> message d'erreur.
Une solution: dans ta macro, tu commences par déprotéger ta feuille, tu exécute ton code. A la fin de celui-ci, une commande reprotège ta feuille.
Bonjour d3d9x
Effectivement la macro fonctionne parfaitement en mode non protégé.
Pour ce qui est de la solution proposé, je ne saisis pas bien votre proposition.
Faut-il a chaque fois enlever la protectioin et la remettre une fois l'action terminé, ou il faut ajouter un code a la macro elle-même.
Dans ce cas j'aurais besoin de support pour y arriver
Merci pour votre réponse
Bigari
Bonjour bigari, bonjour d3d9x.
Pour déprotéger ta feuille, insère ce code en début de procédure :
Unprotect
Et en fin de procédure :
Protect
Haha je n'avais pas regardé ton code, mais je reconnais du code que j'ai écrit xD
Private Const feuilleTravail As String = "Fiche de travail vehicule leger"
Private Const feuilleSauvegarde As String = "Histo"
C'est tout moi
Bref dans ton cas,
Private Const feuilleTravail As String = "Fiche de travail vehicule leger"
Private Const feuilleSauvegarde As String = "Histo"
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Rows.Count <> 1 Or Target.Columns.Count <> 1 Then Exit Sub
If Target.Column <> 17 Or Target.Row < 8 Or Target.Value = "" Then Exit Sub
Sheets(feuilleTravail).Unprotect
Sheets(feuilleSauvegarde).Unprotect
col = Target.Row
Select Case Target.Value
Case "Complété"
lettre = "T"
Range(lettre & col).Select
If Range(lettre & col) = "" Then Range(lettre & col) = Now
Selection.Locked = True
Selection.FormulaHidden = False
Case "En Cours"
lettre = "S"
Range(lettre & col).Select
If Range(lettre & col) = "" Then Range(lettre & col) = Now
Selection.Locked = True
Selection.FormulaHidden = False
Case "En Attente"
lettre = "S"
Range(lettre & col).Select
If Range(lettre & col) = "" Then Range(lettre & col) = Now
Selection.Locked = True
Selection.FormulaHidden = False
Case "Libéré"
Dim transfert As Variant
Dim derniereLigne%
derniereLigne = Sheets(feuilleSauvegarde).Cells(Sheets(feuilleSauvegarde).Rows.Count, "A").End(xlUp).Row
transfert = Sheets(feuilleTravail).Range("B" & col & ":W" & col)
Sheets(feuilleSauvegarde).Range("A" & derniereLigne + 1).Resize(1, UBound(transfert, 2) - LBound(transfert, 1) + 2) = transfert
Sheets(feuilleTravail).Range("H" & col).ClearContents
Sheets(feuilleTravail).Range("Q" & col & ":T" & col).ClearContents
End Select
Sheets(feuilleTravail).Protect
Sheets(feuilleSauvegarde).Protect
End Sub
devrait convenir!
Bonjour d3d9x
Merci pour votre support, maintenant tout fonctionne très bien
Private Const feuilleTravail As String = "Fiche de travail vehicule leger"
Private Const feuilleSauvegarde As String = "Histo"
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Rows.Count <> 1 Or Target.Columns.Count <> 1 Then Exit Sub
If Target.Column <> 17 Or Target.Row < 8 Or Target.Value = "" Then Exit Sub
Sheets(feuilleTravail).Unprotect
Sheets(feuilleSauvegarde).Unprotect
col = Target.Row
Select Case Target.Value
Case "Complété"
lettre = "T"
Range(lettre & col).Select
If Range(lettre & col) = "" Then Range(lettre & col) = Now
Selection.Locked = True
Selection.FormulaHidden = False
Case "En Cours"
lettre = "S"
Range(lettre & col).Select
If Range(lettre & col) = "" Then Range(lettre & col) = Now
Selection.Locked = True
Selection.FormulaHidden = False
Case "En Attente"
lettre = "S"
Range(lettre & col).Select
If Range(lettre & col) = "" Then Range(lettre & col) = Now
Selection.Locked = True
Selection.FormulaHidden = False
Case "Libéré"
[b][b] Case "Mis à l'arrêt"
Dim transfert As Variant
Dim derniereLigne%
derniereLigne = Sheets(feuilleSauvegarde).Cells(Sheets(feuilleSauvegarde).Rows.Count, "A").End(xlUp).Row
transfert = Sheets(feuilleTravail).Range("B" & col & ":W" & col)
Sheets(feuilleSauvegarde).Range("A" & derniereLigne + 1).Resize(1, UBound(transfert, 2) - LBound(transfert, 1) + 2) = transfert
Sheets(feuilleTravail).Range("H" & col).ClearContents
Sheets(feuilleTravail).Range("Q" & col & ":T" & col).ClearContents
End Select
Sheets(feuilleTravail).Protect
Sheets(feuilleSauvegarde).Protect
End Sub