Rajouter des cellules

Le
timili
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")

'Liste des feuille semaine
ArrSem = Array("sem 1", "sem 2", "sem 3", "sem 4", "sem 5")

'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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Daniel.C
Le #21430451
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")

'Liste des feuille semaine
ArrSem = Array("sem 1", "sem 2", "sem 3", "sem 4", "sem 5")

'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
Le #21431011
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")

'Deuxième tableau
Arr2 = Array("A:A", "AK:AM", "BA:BA", "CQ:CM", "DA:DA", _
"EK:EM", "FA:FA", "GK:GM", "HA:HA", "IK:IM")

'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"
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")

'Liste des feuille semaine
ArrSem = Array("sem 1", "sem 2", "sem 3", "sem 4", "sem 5")

'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
Publicité
Poster une réponse
Anonyme