Bonsoir,
la macro de base fonctionne mais je souhaite ajouter des cellules et des plages de cellules et j'ai besoin d'aide .
Cordialement
timili
Sub Auto_Open()
On Error Resume Next
Call traitement
End Sub
'----------------------------------
Sub traitement()
'J'ai ajouté Arr2 et Plg2
Dim Arr(), Arr2(), ArrFeuille(), ArrSem(), DerLig As Long
Dim B As Long, Elt As Variant, Plg As Variant, Plg2 As Variant
'liste des feuille à masquer et non protéger
ArrFeuille = Array("calendrier", "calcul mois", "sem 1 cal", "sem 2 cal", "sem 3 cal", "sem 4 cal", "sem 5 cal")
'Premier tableau pour les plages d'adresses
Arr = Array("C:AJ", "BC:CJ", "DC:EJ", "FC:GJ", "HC:IJ")
'Second tableau pour les plages d'adresses que je souhaite rajouter cela commence à la ligne 7 jusqu'à la ligne 21 avec un pas de 2 dans les feuilles sem1, sem2, sem3, sem4, sem5
Arr2 = Array("A", "AK:AM", "BA", "CQ:CM", "DA", "EK:EM", "FA", "GK:GM", "HA", "IK:IM")
'Rend non visible la liste des feuilles
For Each Elt In ArrFeuille
Sheets(Elt).Visible = xlVeryHidden
'xlSheetHidden : permet d'afficher une feuille
'par le menu de la feuille de calcul
'xlVeryHidden : La feuille devient inaccessible
'par une commande de la feuille de calcul.
'doit utiliser une ligne de code
Next
'Seule la plage B5:C30 est accessible manuellement
'Les macros sur la feuille peuvent s'exécuter.
'"MotDePasse" est le mot de passe de protection de la feuille
With Sheets("Atelier")
.Unprotect "MotDePasse"
.Cells.Locked = True
.Range("B5:C30").Locked = False
.Protect "MotDePasse", True, True, True, True
End With
'pour toutes les feuilles SEM,
'Les formules ne sont pas visibles
'Plages mentionnées accessibles manuellement
'La feuille est accessible par macro
'Seules les cellules non protégées sont sélectionnables.
For Each Elt In ArrSem
With Worksheets(Elt)
.Unprotect "MotDePasse"
.Cells.Locked = True
.UsedRange.SpecialCells(xlCellTypeFormulas).FormulaHidden = True
For Each Plg In Arr
'Dernière cellule occupée dans la plage
DerLig = .Range(Plg).Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
For A = 24 To DerLig Step 4
.Range(Plg).Rows(A).Locked = False
.Protect "MotDePasse", True, True, True, True
Next
'Ma modification pour ajouter des cellules supplémentaires qui sont actuellement verrouillées et doivent être modifiables.
.UsedRange.SpecialCells(xlCellTypeFormulas).FormulaHidden = True
For Each Plg2 In Arr2
'Dernière cellule occupée dans la plage
DerLig = .Range(Plg2).Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
For B = 7 To DerLig Step 2
.Range(Plg2).Rows(B).Locked = True
.Protect "MotDePasse", True, True, True, True
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Daniel.C
Bonjour. Je ne sais pas si c'est ton problème, mais tu ne peux pas écrire : Arr2 = Array("A", "AK:AM", "BA", "CQ:CM", "DA", "EK:EM", "FA", "GK:GM", "HA", "IK:IM") parce que range("A") provoque une erreur. Si tu veux utiliser toute la colonne, tu dois écrire : Arr2 = Array("A:A", "AK:AM", "BA:BA", "CQ:CM", "DA", "EK:EM", "FA:FA", "GK:GM", "HA:HA", "IK:IM") Cordialement. Daniel
Bonsoir, la macro de base fonctionne mais je souhaite ajouter des cellules et des plages de cellules et j'ai besoin d'aide . Cordialement timili
Sub Auto_Open() On Error Resume Next Call traitement End Sub '---------------------------------- Sub traitement() 'J'ai ajouté Arr2 et Plg2 Dim Arr(), Arr2(), ArrFeuille(), ArrSem(), DerLig As Long Dim B As Long, Elt As Variant, Plg As Variant, Plg2 As Variant
'liste des feuille à masquer et non protéger ArrFeuille = Array("calendrier", "calcul mois", "sem 1 cal", "sem 2 cal", "sem 3 cal", "sem 4 cal", "sem 5 cal")
'Premier tableau pour les plages d'adresses Arr = Array("C:AJ", "BC:CJ", "DC:EJ", "FC:GJ", "HC:IJ")
'Second tableau pour les plages d'adresses que je souhaite rajouter cela commence à la ligne 7 jusqu'à la ligne 21 avec un pas de 2 dans les feuilles sem1, sem2, sem3, sem4, sem5 Arr2 = Array("A", "AK:AM", "BA", "CQ:CM", "DA", "EK:EM", "FA", "GK:GM", "HA", "IK:IM")
'Rend non visible la liste des feuilles For Each Elt In ArrFeuille Sheets(Elt).Visible = xlVeryHidden 'xlSheetHidden : permet d'afficher une feuille 'par le menu de la feuille de calcul 'xlVeryHidden : La feuille devient inaccessible 'par une commande de la feuille de calcul. 'doit utiliser une ligne de code Next
'Seule la plage B5:C30 est accessible manuellement 'Les macros sur la feuille peuvent s'exécuter. '"MotDePasse" est le mot de passe de protection de la feuille With Sheets("Atelier") .Unprotect "MotDePasse" .Cells.Locked = True .Range("B5:C30").Locked = False .Protect "MotDePasse", True, True, True, True End With
'pour toutes les feuilles SEM, 'Les formules ne sont pas visibles 'Plages mentionnées accessibles manuellement 'La feuille est accessible par macro 'Seules les cellules non protégées sont sélectionnables. For Each Elt In ArrSem With Worksheets(Elt) .Unprotect "MotDePasse" .Cells.Locked = True .UsedRange.SpecialCells(xlCellTypeFormulas).FormulaHidden = True For Each Plg In Arr 'Dernière cellule occupée dans la plage DerLig = .Range(Plg).Find(What:="*", _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row For A = 24 To DerLig Step 4 .Range(Plg).Rows(A).Locked = False .Protect "MotDePasse", True, True, True, True Next
'Ma modification pour ajouter des cellules supplémentaires qui sont actuellement verrouillées et doivent être modifiables. .UsedRange.SpecialCells(xlCellTypeFormulas).FormulaHidden = True For Each Plg2 In Arr2 'Dernière cellule occupée dans la plage DerLig = .Range(Plg2).Find(What:="*", _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row For B = 7 To DerLig Step 2 .Range(Plg2).Rows(B).Locked = True .Protect "MotDePasse", True, True, True, True
Next Next Next End With Next End Sub
Bonjour.
Je ne sais pas si c'est ton problème, mais tu ne peux pas écrire :
Arr2 = Array("A", "AK:AM", "BA", "CQ:CM", "DA", "EK:EM", "FA", "GK:GM",
"HA", "IK:IM")
parce que range("A") provoque une erreur. Si tu veux utiliser toute la
colonne, tu dois écrire :
Arr2 = Array("A:A", "AK:AM", "BA:BA", "CQ:CM", "DA", "EK:EM", "FA:FA",
"GK:GM", "HA:HA", "IK:IM")
Cordialement.
Daniel
Bonsoir,
la macro de base fonctionne mais je souhaite ajouter des cellules et des
plages de cellules et j'ai besoin d'aide .
Cordialement
timili
Sub Auto_Open()
On Error Resume Next
Call traitement
End Sub
'----------------------------------
Sub traitement()
'J'ai ajouté Arr2 et Plg2
Dim Arr(), Arr2(), ArrFeuille(), ArrSem(), DerLig As Long
Dim B As Long, Elt As Variant, Plg As Variant, Plg2 As Variant
'liste des feuille à masquer et non protéger
ArrFeuille = Array("calendrier", "calcul mois", "sem 1 cal", "sem 2 cal",
"sem 3 cal", "sem 4 cal", "sem 5 cal")
'Premier tableau pour les plages d'adresses
Arr = Array("C:AJ", "BC:CJ", "DC:EJ", "FC:GJ", "HC:IJ")
'Second tableau pour les plages d'adresses que je souhaite rajouter cela
commence à la ligne 7 jusqu'à la ligne 21 avec un pas de 2 dans les feuilles
sem1, sem2, sem3, sem4, sem5
Arr2 = Array("A", "AK:AM", "BA", "CQ:CM", "DA", "EK:EM", "FA", "GK:GM", "HA",
"IK:IM")
'Rend non visible la liste des feuilles
For Each Elt In ArrFeuille
Sheets(Elt).Visible = xlVeryHidden
'xlSheetHidden : permet d'afficher une feuille
'par le menu de la feuille de calcul
'xlVeryHidden : La feuille devient inaccessible
'par une commande de la feuille de calcul.
'doit utiliser une ligne de code
Next
'Seule la plage B5:C30 est accessible manuellement
'Les macros sur la feuille peuvent s'exécuter.
'"MotDePasse" est le mot de passe de protection de la feuille
With Sheets("Atelier")
.Unprotect "MotDePasse"
.Cells.Locked = True
.Range("B5:C30").Locked = False
.Protect "MotDePasse", True, True, True, True
End With
'pour toutes les feuilles SEM,
'Les formules ne sont pas visibles
'Plages mentionnées accessibles manuellement
'La feuille est accessible par macro
'Seules les cellules non protégées sont sélectionnables.
For Each Elt In ArrSem
With Worksheets(Elt)
.Unprotect "MotDePasse"
.Cells.Locked = True
.UsedRange.SpecialCells(xlCellTypeFormulas).FormulaHidden = True
For Each Plg In Arr
'Dernière cellule occupée dans la plage
DerLig = .Range(Plg).Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
For A = 24 To DerLig Step 4
.Range(Plg).Rows(A).Locked = False
.Protect "MotDePasse", True, True, True, True
Next
'Ma modification pour ajouter des cellules supplémentaires qui sont
actuellement verrouillées et doivent être modifiables.
.UsedRange.SpecialCells(xlCellTypeFormulas).FormulaHidden = True
For Each Plg2 In Arr2
'Dernière cellule occupée dans la plage
DerLig = .Range(Plg2).Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
For B = 7 To DerLig Step 2
.Range(Plg2).Rows(B).Locked = True
.Protect "MotDePasse", True, True, True, True
Bonjour. Je ne sais pas si c'est ton problème, mais tu ne peux pas écrire : Arr2 = Array("A", "AK:AM", "BA", "CQ:CM", "DA", "EK:EM", "FA", "GK:GM", "HA", "IK:IM") parce que range("A") provoque une erreur. Si tu veux utiliser toute la colonne, tu dois écrire : Arr2 = Array("A:A", "AK:AM", "BA:BA", "CQ:CM", "DA", "EK:EM", "FA:FA", "GK:GM", "HA:HA", "IK:IM") Cordialement. Daniel
Bonsoir, la macro de base fonctionne mais je souhaite ajouter des cellules et des plages de cellules et j'ai besoin d'aide . Cordialement timili
Sub Auto_Open() On Error Resume Next Call traitement End Sub '---------------------------------- Sub traitement() 'J'ai ajouté Arr2 et Plg2 Dim Arr(), Arr2(), ArrFeuille(), ArrSem(), DerLig As Long Dim B As Long, Elt As Variant, Plg As Variant, Plg2 As Variant
'liste des feuille à masquer et non protéger ArrFeuille = Array("calendrier", "calcul mois", "sem 1 cal", "sem 2 cal", "sem 3 cal", "sem 4 cal", "sem 5 cal")
'Premier tableau pour les plages d'adresses Arr = Array("C:AJ", "BC:CJ", "DC:EJ", "FC:GJ", "HC:IJ")
'Second tableau pour les plages d'adresses que je souhaite rajouter cela commence à la ligne 7 jusqu'à la ligne 21 avec un pas de 2 dans les feuilles sem1, sem2, sem3, sem4, sem5 Arr2 = Array("A", "AK:AM", "BA", "CQ:CM", "DA", "EK:EM", "FA", "GK:GM", "HA", "IK:IM")
'Rend non visible la liste des feuilles For Each Elt In ArrFeuille Sheets(Elt).Visible = xlVeryHidden 'xlSheetHidden : permet d'afficher une feuille 'par le menu de la feuille de calcul 'xlVeryHidden : La feuille devient inaccessible 'par une commande de la feuille de calcul. 'doit utiliser une ligne de code Next
'Seule la plage B5:C30 est accessible manuellement 'Les macros sur la feuille peuvent s'exécuter. '"MotDePasse" est le mot de passe de protection de la feuille With Sheets("Atelier") .Unprotect "MotDePasse" .Cells.Locked = True .Range("B5:C30").Locked = False .Protect "MotDePasse", True, True, True, True End With
'pour toutes les feuilles SEM, 'Les formules ne sont pas visibles 'Plages mentionnées accessibles manuellement 'La feuille est accessible par macro 'Seules les cellules non protégées sont sélectionnables. For Each Elt In ArrSem With Worksheets(Elt) .Unprotect "MotDePasse" .Cells.Locked = True .UsedRange.SpecialCells(xlCellTypeFormulas).FormulaHidden = True For Each Plg In Arr 'Dernière cellule occupée dans la plage DerLig = .Range(Plg).Find(What:="*", _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row For A = 24 To DerLig Step 4 .Range(Plg).Rows(A).Locked = False .Protect "MotDePasse", True, True, True, True Next
'Ma modification pour ajouter des cellules supplémentaires qui sont actuellement verrouillées et doivent être modifiables. .UsedRange.SpecialCells(xlCellTypeFormulas).FormulaHidden = True For Each Plg2 In Arr2 'Dernière cellule occupée dans la plage DerLig = .Range(Plg2).Find(What:="*", _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row For B = 7 To DerLig Step 2 .Range(Plg2).Rows(B).Locked = True .Protect "MotDePasse", True, True, True, True
Next Next Next End With Next End Sub
michdenis
Bonjour,
Essaie ceci :
'----------------------------------------------- Sub traitement() Dim Arr(), ArrFeuille(), ArrSem(), DerLig As Long Dim B As Long, Elt As Variant, Plg As Variant Dim Arr2(), Plg2 As Variant
'liste des feuille à masquer et non protéger ArrFeuille = Array("calendrier", "calcul mois", "sem 1 cal", _ "sem 2 cal", "sem 3 cal", "sem 4 cal", "sem 5 cal")
'Liste des feuille semaine ArrSem = Array("sem 1", "sem 2", "sem 3", "sem 4", "sem 5") 'Un tableau pour les plages d'adresses Arr = Array("C:AJ", "BC:CJ", "DC:EJ", "FC:GJ", "HC:IJ")
'Rend non visible la liste des feuilles For Each Elt In ArrFeuille Sheets(Elt).Visible = xlSheetHidden 'xlSheetHidden : permet d'afficher une feuille 'par le menu de la feuille de calcul 'xlVeryHidden : La feuille devient inaccessible 'par une commande de la feuille de calcul. 'doit utiliser une ligne de code Next
'Seule la plage B5:C30 est accessible manuellement 'Les macros sur la feuille peuvent s'exécuter. '"MotDePasse" est le mot de passe de protection de la feuille With Sheets("Atelier") .Unprotect "MotDePasse" .Cells.Locked = True .Range("B5:C30").Locked = False .Protect "MotDePasse", True, True, True, True End With
'pour toutes les feuilles SEM, '- Les formules ne sont pas visibles '-Plages mentionnées accessibles manuellement '-La feuille est accessible par macro '- Seules les cellules non protégées sont sélectionnables. For Each Elt In ArrSem With Worksheets(Elt) .Unprotect "MotDePasse" .Cells.Locked = True .UsedRange.SpecialCells(xlCellTypeFormulas).FormulaHidden = True For Each Plg2 In Arr2 'Dernière cellule occupée dans la plage For a = 7 To 21 Step 2 .Range(Plg2).Rows(a).Locked = False Next Next
For Each Plg In Arr 'Dernière cellule occupée dans la plage DerLig = .Range(Plg).Find(What:="*", _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row For a = 24 To DerLig Step 4 .Range(Plg).Rows(a).Locked = False Next Next .Protect "MotDePasse", True, True, True, True End With Next End Sub '-----------------------------------------------
"timili" a écrit dans le message de groupe de discussion :
Bonsoir, la macro de base fonctionne mais je souhaite ajouter des cellules et des plages de cellules et j'ai besoin d'aide . Cordialement timili
Sub Auto_Open() On Error Resume Next Call traitement End Sub '---------------------------------- Sub traitement() 'J'ai ajouté Arr2 et Plg2 Dim Arr(), Arr2(), ArrFeuille(), ArrSem(), DerLig As Long Dim B As Long, Elt As Variant, Plg As Variant, Plg2 As Variant
'liste des feuille à masquer et non protéger ArrFeuille = Array("calendrier", "calcul mois", "sem 1 cal", "sem 2 cal", "sem 3 cal", "sem 4 cal", "sem 5 cal")
'Premier tableau pour les plages d'adresses Arr = Array("C:AJ", "BC:CJ", "DC:EJ", "FC:GJ", "HC:IJ")
'Second tableau pour les plages d'adresses que je souhaite rajouter cela commence à la ligne 7 jusqu'à la ligne 21 avec un pas de 2 dans les feuilles sem1, sem2, sem3, sem4, sem5 Arr2 = Array("A", "AK:AM", "BA", "CQ:CM", "DA", "EK:EM", "FA", "GK:GM", "HA", "IK:IM")
'Rend non visible la liste des feuilles For Each Elt In ArrFeuille Sheets(Elt).Visible = xlVeryHidden 'xlSheetHidden : permet d'afficher une feuille 'par le menu de la feuille de calcul 'xlVeryHidden : La feuille devient inaccessible 'par une commande de la feuille de calcul. 'doit utiliser une ligne de code Next
'Seule la plage B5:C30 est accessible manuellement 'Les macros sur la feuille peuvent s'exécuter. '"MotDePasse" est le mot de passe de protection de la feuille With Sheets("Atelier") .Unprotect "MotDePasse" .Cells.Locked = True .Range("B5:C30").Locked = False .Protect "MotDePasse", True, True, True, True End With
'pour toutes les feuilles SEM, 'Les formules ne sont pas visibles 'Plages mentionnées accessibles manuellement 'La feuille est accessible par macro 'Seules les cellules non protégées sont sélectionnables. For Each Elt In ArrSem With Worksheets(Elt) .Unprotect "MotDePasse" .Cells.Locked = True .UsedRange.SpecialCells(xlCellTypeFormulas).FormulaHidden = True For Each Plg In Arr 'Dernière cellule occupée dans la plage DerLig = .Range(Plg).Find(What:="*", _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row For A = 24 To DerLig Step 4 .Range(Plg).Rows(A).Locked = False .Protect "MotDePasse", True, True, True, True Next
'Ma modification pour ajouter des cellules supplémentaires qui sont actuellement verrouillées et doivent être modifiables. .UsedRange.SpecialCells(xlCellTypeFormulas).FormulaHidden = True For Each Plg2 In Arr2 'Dernière cellule occupée dans la plage DerLig = .Range(Plg2).Find(What:="*", _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row For B = 7 To DerLig Step 2 .Range(Plg2).Rows(B).Locked = True .Protect "MotDePasse", True, True, True, True
Next Next Next End With Next End Sub
Bonjour,
Essaie ceci :
'-----------------------------------------------
Sub traitement()
Dim Arr(), ArrFeuille(), ArrSem(), DerLig As Long
Dim B As Long, Elt As Variant, Plg As Variant
Dim Arr2(), Plg2 As Variant
'liste des feuille à masquer et non protéger
ArrFeuille = Array("calendrier", "calcul mois", "sem 1 cal", _
"sem 2 cal", "sem 3 cal", "sem 4 cal", "sem 5 cal")
'Liste des feuille semaine
ArrSem = Array("sem 1", "sem 2", "sem 3", "sem 4", "sem 5")
'Un tableau pour les plages d'adresses
Arr = Array("C:AJ", "BC:CJ", "DC:EJ", "FC:GJ", "HC:IJ")
'Rend non visible la liste des feuilles
For Each Elt In ArrFeuille
Sheets(Elt).Visible = xlSheetHidden
'xlSheetHidden : permet d'afficher une feuille
'par le menu de la feuille de calcul
'xlVeryHidden : La feuille devient inaccessible
'par une commande de la feuille de calcul.
'doit utiliser une ligne de code
Next
'Seule la plage B5:C30 est accessible manuellement
'Les macros sur la feuille peuvent s'exécuter.
'"MotDePasse" est le mot de passe de protection de la feuille
With Sheets("Atelier")
.Unprotect "MotDePasse"
.Cells.Locked = True
.Range("B5:C30").Locked = False
.Protect "MotDePasse", True, True, True, True
End With
'pour toutes les feuilles SEM,
'- Les formules ne sont pas visibles
'-Plages mentionnées accessibles manuellement
'-La feuille est accessible par macro
'- Seules les cellules non protégées sont sélectionnables.
For Each Elt In ArrSem
With Worksheets(Elt)
.Unprotect "MotDePasse"
.Cells.Locked = True
.UsedRange.SpecialCells(xlCellTypeFormulas).FormulaHidden = True
For Each Plg2 In Arr2
'Dernière cellule occupée dans la plage
For a = 7 To 21 Step 2
.Range(Plg2).Rows(a).Locked = False
Next
Next
For Each Plg In Arr
'Dernière cellule occupée dans la plage
DerLig = .Range(Plg).Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
For a = 24 To DerLig Step 4
.Range(Plg).Rows(a).Locked = False
Next
Next
.Protect "MotDePasse", True, True, True, True
End With
Next
End Sub
'-----------------------------------------------
"timili" <nospam_r.e.michel@free.fr> a écrit dans le message de groupe de discussion :
uM-dnQY9aOcOxDTW4p2dnAA@giganews.com...
Bonsoir,
la macro de base fonctionne mais je souhaite ajouter des cellules et des plages
de cellules et j'ai besoin d'aide .
Cordialement
timili
Sub Auto_Open()
On Error Resume Next
Call traitement
End Sub
'----------------------------------
Sub traitement()
'J'ai ajouté Arr2 et Plg2
Dim Arr(), Arr2(), ArrFeuille(), ArrSem(), DerLig As Long
Dim B As Long, Elt As Variant, Plg As Variant, Plg2 As Variant
'liste des feuille à masquer et non protéger
ArrFeuille = Array("calendrier", "calcul mois", "sem 1 cal", "sem 2 cal", "sem
3 cal", "sem 4 cal", "sem 5 cal")
'Premier tableau pour les plages d'adresses
Arr = Array("C:AJ", "BC:CJ", "DC:EJ", "FC:GJ", "HC:IJ")
'Second tableau pour les plages d'adresses que je souhaite rajouter cela
commence à la ligne 7 jusqu'à la ligne 21 avec un pas de 2 dans les feuilles
sem1, sem2, sem3, sem4, sem5
Arr2 = Array("A", "AK:AM", "BA", "CQ:CM", "DA", "EK:EM", "FA", "GK:GM", "HA",
"IK:IM")
'Rend non visible la liste des feuilles
For Each Elt In ArrFeuille
Sheets(Elt).Visible = xlVeryHidden
'xlSheetHidden : permet d'afficher une feuille
'par le menu de la feuille de calcul
'xlVeryHidden : La feuille devient inaccessible
'par une commande de la feuille de calcul.
'doit utiliser une ligne de code
Next
'Seule la plage B5:C30 est accessible manuellement
'Les macros sur la feuille peuvent s'exécuter.
'"MotDePasse" est le mot de passe de protection de la feuille
With Sheets("Atelier")
.Unprotect "MotDePasse"
.Cells.Locked = True
.Range("B5:C30").Locked = False
.Protect "MotDePasse", True, True, True, True
End With
'pour toutes les feuilles SEM,
'Les formules ne sont pas visibles
'Plages mentionnées accessibles manuellement
'La feuille est accessible par macro
'Seules les cellules non protégées sont sélectionnables.
For Each Elt In ArrSem
With Worksheets(Elt)
.Unprotect "MotDePasse"
.Cells.Locked = True
.UsedRange.SpecialCells(xlCellTypeFormulas).FormulaHidden = True
For Each Plg In Arr
'Dernière cellule occupée dans la plage
DerLig = .Range(Plg).Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
For A = 24 To DerLig Step 4
.Range(Plg).Rows(A).Locked = False
.Protect "MotDePasse", True, True, True, True
Next
'Ma modification pour ajouter des cellules supplémentaires qui sont
actuellement verrouillées et doivent être modifiables.
.UsedRange.SpecialCells(xlCellTypeFormulas).FormulaHidden = True
For Each Plg2 In Arr2
'Dernière cellule occupée dans la plage
DerLig = .Range(Plg2).Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
For B = 7 To DerLig Step 2
.Range(Plg2).Rows(B).Locked = True
.Protect "MotDePasse", True, True, True, True
'----------------------------------------------- Sub traitement() Dim Arr(), ArrFeuille(), ArrSem(), DerLig As Long Dim B As Long, Elt As Variant, Plg As Variant Dim Arr2(), Plg2 As Variant
'liste des feuille à masquer et non protéger ArrFeuille = Array("calendrier", "calcul mois", "sem 1 cal", _ "sem 2 cal", "sem 3 cal", "sem 4 cal", "sem 5 cal")
'Liste des feuille semaine ArrSem = Array("sem 1", "sem 2", "sem 3", "sem 4", "sem 5") 'Un tableau pour les plages d'adresses Arr = Array("C:AJ", "BC:CJ", "DC:EJ", "FC:GJ", "HC:IJ")
'Rend non visible la liste des feuilles For Each Elt In ArrFeuille Sheets(Elt).Visible = xlSheetHidden 'xlSheetHidden : permet d'afficher une feuille 'par le menu de la feuille de calcul 'xlVeryHidden : La feuille devient inaccessible 'par une commande de la feuille de calcul. 'doit utiliser une ligne de code Next
'Seule la plage B5:C30 est accessible manuellement 'Les macros sur la feuille peuvent s'exécuter. '"MotDePasse" est le mot de passe de protection de la feuille With Sheets("Atelier") .Unprotect "MotDePasse" .Cells.Locked = True .Range("B5:C30").Locked = False .Protect "MotDePasse", True, True, True, True End With
'pour toutes les feuilles SEM, '- Les formules ne sont pas visibles '-Plages mentionnées accessibles manuellement '-La feuille est accessible par macro '- Seules les cellules non protégées sont sélectionnables. For Each Elt In ArrSem With Worksheets(Elt) .Unprotect "MotDePasse" .Cells.Locked = True .UsedRange.SpecialCells(xlCellTypeFormulas).FormulaHidden = True For Each Plg2 In Arr2 'Dernière cellule occupée dans la plage For a = 7 To 21 Step 2 .Range(Plg2).Rows(a).Locked = False Next Next
For Each Plg In Arr 'Dernière cellule occupée dans la plage DerLig = .Range(Plg).Find(What:="*", _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row For a = 24 To DerLig Step 4 .Range(Plg).Rows(a).Locked = False Next Next .Protect "MotDePasse", True, True, True, True End With Next End Sub '-----------------------------------------------
"timili" a écrit dans le message de groupe de discussion :
Bonsoir, la macro de base fonctionne mais je souhaite ajouter des cellules et des plages de cellules et j'ai besoin d'aide . Cordialement timili
Sub Auto_Open() On Error Resume Next Call traitement End Sub '---------------------------------- Sub traitement() 'J'ai ajouté Arr2 et Plg2 Dim Arr(), Arr2(), ArrFeuille(), ArrSem(), DerLig As Long Dim B As Long, Elt As Variant, Plg As Variant, Plg2 As Variant
'liste des feuille à masquer et non protéger ArrFeuille = Array("calendrier", "calcul mois", "sem 1 cal", "sem 2 cal", "sem 3 cal", "sem 4 cal", "sem 5 cal")
'Premier tableau pour les plages d'adresses Arr = Array("C:AJ", "BC:CJ", "DC:EJ", "FC:GJ", "HC:IJ")
'Second tableau pour les plages d'adresses que je souhaite rajouter cela commence à la ligne 7 jusqu'à la ligne 21 avec un pas de 2 dans les feuilles sem1, sem2, sem3, sem4, sem5 Arr2 = Array("A", "AK:AM", "BA", "CQ:CM", "DA", "EK:EM", "FA", "GK:GM", "HA", "IK:IM")
'Rend non visible la liste des feuilles For Each Elt In ArrFeuille Sheets(Elt).Visible = xlVeryHidden 'xlSheetHidden : permet d'afficher une feuille 'par le menu de la feuille de calcul 'xlVeryHidden : La feuille devient inaccessible 'par une commande de la feuille de calcul. 'doit utiliser une ligne de code Next
'Seule la plage B5:C30 est accessible manuellement 'Les macros sur la feuille peuvent s'exécuter. '"MotDePasse" est le mot de passe de protection de la feuille With Sheets("Atelier") .Unprotect "MotDePasse" .Cells.Locked = True .Range("B5:C30").Locked = False .Protect "MotDePasse", True, True, True, True End With
'pour toutes les feuilles SEM, 'Les formules ne sont pas visibles 'Plages mentionnées accessibles manuellement 'La feuille est accessible par macro 'Seules les cellules non protégées sont sélectionnables. For Each Elt In ArrSem With Worksheets(Elt) .Unprotect "MotDePasse" .Cells.Locked = True .UsedRange.SpecialCells(xlCellTypeFormulas).FormulaHidden = True For Each Plg In Arr 'Dernière cellule occupée dans la plage DerLig = .Range(Plg).Find(What:="*", _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row For A = 24 To DerLig Step 4 .Range(Plg).Rows(A).Locked = False .Protect "MotDePasse", True, True, True, True Next
'Ma modification pour ajouter des cellules supplémentaires qui sont actuellement verrouillées et doivent être modifiables. .UsedRange.SpecialCells(xlCellTypeFormulas).FormulaHidden = True For Each Plg2 In Arr2 'Dernière cellule occupée dans la plage DerLig = .Range(Plg2).Find(What:="*", _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row For B = 7 To DerLig Step 2 .Range(Plg2).Rows(B).Locked = True .Protect "MotDePasse", True, True, True, True