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 Par contre les ".Select" je n'espère pas!

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

Rechercher des sujets similaires à "macro qui fonctionne pas mode feuille protege"