insertion lignes+ protection feuille

[stephane.quinquis]

Bonjour le forum

J'ai un problème avec mon insertion de lignes et ma macro. Je sais d'où il vient mais je n'arrive pas à le résoudre.
J'ai une macro qui insère une ligne à un endroit précis. J'aimerai protéger une plage de données précises afin que mes utilisateurs ne puissent écrire ou modifier quoi que ce soit.
Dans mon exemple, la plage de données A1:F6.
Mon insertion de lignes se fait actuellement par un décaler vers le bas or comme la plage de données est protégé, la macro bug.

Voici mon code:

Sub nouvellemiseenstock()
'
' nouvellemiseenstock Macro
' Macro enregistrée le 02/06/2010 par quinquis
'
ActiveSheet.Unprotect
 Range("A7:F7").Select
    Selection.Insert Shift:=xlDown
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("A7:F7").Select
    With Selection
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Selection.Interior.ColorIndex = 2
    Selection.Font.ColorIndex = 0
    Selection.Locked = False
    Range("G7:CT7").Select
    With Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
  Sheets("enregistrement").Select
    Range("A7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("mise en stock").Select
    Range("A7").Select
    ActiveSheet.Paste
    Sheets("enregistrement").Select
    Range("A9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("mise en stock").Select
    Range("B7").Select
    ActiveSheet.Paste
    Sheets("enregistrement").Select
    Range("F7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("mise en stock").Select
    Range("C7").Select
    ActiveSheet.Paste
    Sheets("enregistrement").Select
    Range("D9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("mise en stock").Select
    Range("E7").Select
    ActiveSheet.Paste
    ActiveSheet.Unprotect
End Sub

Je pensais qu'en mettant au début

ActiveSheet.Unprotect

et à la fin

ActiveSheet.Protect

Cela pourrait résoudre mon problème mais il me demande le mot de passe pour ôter la protection de feuille or je ne veux pas qu'il soit afficher.
Merci d'avance.

Fichier exemple enregistrement pertes:

Cijoint.fr - Service gratuit de dépôt de fichiers

 

[Ubot303]

Re : insertion lignes+ protection feuille

Bonjour,

Si tu as mis un mot de passe, il faut que tu mettes :

ActiveSheet.Unprotect "Toto"
Si ton mot de passe est toto

Pour ne pas qu'un utilisateur averti voit le code ou ton mot de passe est en clair, il faut que tu verrouilles ton projet (clic droit dans l'explorateur d'objet VB) -> Propriétés -> Onglet Protection

 

[stephane.quinquis]

Re : insertion lignes+ protection feuille

Bonjour Ubot 303, bonjour le forum

Merci Ubot303. cela a l'air de fonctionner.

Il y a juste un mais comme d'habitude. Dans le cas de l'intégration d'une gestion des erreurs dans ma macro du style:

If ActiveSheet.Range("D6") = "" Then MsgBox "Veuillez entrer vos initiales ": Exit Sub

La protection de la feuille se désactive. As-tu une explication???
Merci d'avance

 

[job75]

Re : insertion lignes+ protection feuille

Bonjour,

Explication : Exit Sub fait sortir de la macro avant que la feuille ne soit reprotégée

Donc écrire :

If ActiveSheet.Range("D6") = "" Then MsgBox "Veuillez entrer vos initiales ": [COLOR="Red"]GoTo 1[/COLOR]
'-------
1 ActiveSheet.Protect "toto"

A+

 

[stephane.quinquis]

Re : insertion lignes+ protection feuille

Bonjour Job75,

tu m'avais déjà aidé à monter de gestion des erreurs avec le code suivant:

ActiveSheet.Unprotect "SDCD"
Dim co As Workbook 'déclare la variable co (Classeur Origine)
Set co = ThisWorkbook 'définit le classeur Origine
On Error Resume Next
If IsError(Workbooks("inventaire production.xls").Name) Then GoTo 1
2 MsgBox "Transfert impossible. Recommencez dans 10 secondes"
Exit Sub
1 On Error GoTo 0
If ActiveSheet.Range("D6") = "" Then MsgBox "Veuillez entrer vos initiales ": Exit Sub
If ActiveSheet.Range("Q6") = "" Then MsgBox "Veuillez entrer le contenu du bac ": Exit Sub
If ActiveSheet.Range("X6") = "" Then MsgBox "Veuillez entrer votre poids ": Exit Sub
If ActiveSheet.Range("B6:X6").Interior.ColorIndex <> 2 Then MsgBox "Ligne déjà Copiée": Exit Sub
Workbooks.Open ""
If ActiveWorkbook.ReadOnly Then ActiveWorkbook.Close False: GoTo 2

Merci beaucoup mais comment intégrer dans cette macro un GoTo. Je suis un peu emmélé avec tout ça.
Merci d'avance.

 

[job75]

Re : insertion lignes+ protection feuille

Re,

Il me semble que tous ces contrôles d'erreur pourraient être placés avant ActiveSheet.Unprotect, ce qui simplifierait tout, non ??

Mais puisque vous le voulez :

ActiveSheet.Unprotect "SDCD"
Dim co As Workbook 'déclare la variable co (Classeur Origine)
Set co = ThisWorkbook 'définit le classeur Origine
On Error Resume Next
If IsError(Workbooks("inventaire production.xls").Name) Then GoTo 1
2 MsgBox "Transfert impossible. Recommencez dans 10 secondes"
[COLOR="Red"]GoTo 3[/COLOR]
1 On Error GoTo 0
If ActiveSheet.Range("D6") = "" Then MsgBox "Veuillez entrer vos initiales ": [COLOR="red"]GoTo 3[/COLOR]
If ActiveSheet.Range("Q6") = "" Then MsgBox "Veuillez entrer le contenu du bac ": [COLOR="red"]GoTo 3[/COLOR]
If ActiveSheet.Range("X6") = "" Then MsgBox "Veuillez entrer votre poids ": [COLOR="red"]GoTo 3[/COLOR]
If ActiveSheet.Range("B6:X6").Interior.ColorIndex <> 2 Then MsgBox "Ligne déjà Copiée": [COLOR="red"]GoTo 3[/COLOR]
Workbooks.Open ""
If ActiveWorkbook.ReadOnly Then ActiveWorkbook.Close False: GoTo 2
[COLOR="red"]3[/COLOR] ActiveSheet.Protect "SDCD"

A+

 

[stephane.quinquis]

Re : insertion lignes+ protection feuille

Bonjour Job75,

Encore merci pour le dépannage express. J'ai opté pour la première solution plus simple et plus efficace.