XL 2010 Ajout et suppression de ligne de tableau quand la feuille est protégé!

[Kamalo]

Bonjour à tous,

J'ai un tableau dans une feuille et je voulais ajouter et/ou supprimer une ligne de tableau à l'aide de macro surtout quand ma feuille est protégée.
J'ai essayé avec les paramètres insérer une ligne lors de la protection mais ça marche pas!
Mon fichier en pièce jointe.

Merci d'avance

 

[fanfan38]

Bonjour
Il suffit de mettre
ActiveSheet.Unprotect
avec le mot de passe entre parenthèse si nécessaire
Ne pas oublier de mettre
ActiveSheet.protect(mdp)
pour remettre la protection

A+ François

 

[soan]

Bonjour fanfan38,

tu devrais essayer ActiveSheet.Unprotect mdp puis ActiveSheet.Protect mdp : tu pourras voir que ça marche très bien sans mettre de parenthèses. 😉​

soan

 

[Kamalo]

Bonjour soan,

Merci à vos réponses!
J'ai essayé mais je sais pas trop pouvez vous m'aider dans le fichier en pièce jointe!

Merci d'avance!

 

[fanfan38]

Bonjour
J'espère que ça correspond à tes souhaits
A+ François
Ps j'ai enlevé des données pour pouvoir joindre le fichier

 

[Kamalo]

Bonjour
J'espère que ça correspond à tes souhaits
A+ François
Ps j'ai enlevé des données pour pouvoir joindre le fichier

Bonjour Fanfan38,

Je pense que il y a pas de changement sur mon fichier!

Merci!

 

[fanfan38]

Bonjour
Il faudra être plus précis. A quel moment as tu besoin de déverrouiller la feuille?
est ce dans le module saisie ou le module entrée?
Worksheets("Data") ? il n'y a pas de feuille Data...
A+ François

 

[soan]

Bonjour Kamalo, François,

juste un essai, à partir du fichier .zip de ton post #4. 🙂

Sub Saisie()
  If ActiveSheet.Name <> "Feuille1" Then Exit Sub
  Dim cel As Range: Set cel = [J18]
  Application.ScreenUpdating = 0: Application.Calculation = -4105
  With Worksheets("Feuille2")
    .Select: .Unprotect
    ActiveSheet.ListObjects("Tableau615").ListRows.Add 1
    ActiveSheet.ListObjects("Tableau504").ListRows.Add 2
    [K2] = cel: [F3] = cel: cel.ClearContents
    .Protect
  End With
  Worksheets("Feuille1").Select
End Sub

bonus : j'ai aussi modifié cette sub :

Sub Archiver()
  Dim Derlig&, Premlig&
  Premlig = Worksheets("Archive").Cells(Rows.Count, 2).End(3).Row + 1
  If [Feuille1!B1] = Worksheets("Archive").Cells(Premlig - 1, 1) Then Exit Sub
  Derlig = Worksheets("Feuille1").Cells(Rows.Count, 2).End(3).Row: Application.ScreenUpdating = 0
  Worksheets("Archive").Select: Worksheets("Feuille1").Range("B5:H" & Derlig).Copy
  Cells(Premlig, 2).PasteSpecial -4163: Application.CutCopyMode = 0
  Derlig = Cells(Rows.Count, 2).End(3).Row
  With Cells(Premlig, 1)
    .Value = Date: .AutoFill .Resize(Derlig - Premlig + 1), 1
  End With
  Worksheets("Feuille1").Select
End Sub

soan

 

[Kamalo]

Merci à vous tous!