Protection cellules

[mcj1997]

Bonjour,

J'ai un fichier avec plus de 60 feuilles qui contiennent chacune des tableaux avec formules, je souhaite le plus simplement et rapidement possible protéger toutes les cases comportant des formules sur toutes les feuilles en même temps si possible.

Merci d'avance,

 

[PMO2]

Re : Protection cellules

Bonjour,

Une piste en VBA qui interdit la sélection de cellules contenant une formule.

Copiez le code suivant dans la fenêtre de code de ThisWorkbook

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim R As Range
On Error Resume Next
Application.EnableEvents = False
Set R = Application.Intersect(Target, Selection.SpecialCells(xlCellTypeFormulas))
Application.EnableEvents = True
If Not R Is Nothing Then Target.Cells(1, 1).Offset(1, 0).Select
End Sub

Cordialement.

PMO
Patrick Morange

 

[Pierrot93]

Re : Protection cellules

Bonjour mcj, Patrick

Patrick, je ne comprends pas trop pourquoi tu réactives les procédures événementielles avant le "select"... Perso je l'aurais mis après, afin d'éviter de passer une 2ème fois dans la procédure... Ou alors quelque chose doit m'échapper...

Option Explicit
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim R As Range
On Error Resume Next
Application.EnableEvents = False
Set R = Application.Intersect(Target, Selection.SpecialCells(xlCellTypeFormulas))
If Not R Is Nothing Then Target.Cells(1, 1).Offset(1, 0).Select
[B]Application.EnableEvents = True[/B]
End Sub

bonne journée.
@+

 

[PMO2]

Re : Protection cellules

Bonjour Pierrot,

Patrick, je ne comprends pas trop pourquoi tu réactives les procédures événementielles avant le "select"... Perso je l'aurais mis après, afin d'éviter de passer une 2ème fois dans la procédure... Ou alors quelque chose doit m'échapper...

Cela semble effectivement déroutant et il y a de quoi être interpellé mais en voici la raison :

Supposons une plage A1 : A5 dans laquelle seule A2 contient une formule et que
l'utilisateur sélectionne cette plage (A1 : A5), la nouvelle cellule active sera A2
et, comme elle contient une formule, il est nécessaire de repasser par Workbook_SheetSelectionChange pour qu'elle ne reste pas activée.

Bonne journée à toi aussi.

PMO
Patrick Morange

 

[Pierrot93]

Re : Protection cellules

Re

Merci Patrick pour ta réponse, je me doutais un petit peu que ce n'était pas par erreur, mais ne voyant pas du tout le pourquoi de la chose, je comprends mieux maintenant. Te souhaitant de bonne fêtes de fin d'année. @+

 

[mcj1997]

Re : Protection cellules

Bonjour,

Une piste en VBA qui interdit la sélection de cellules contenant une formule.

Copiez le code suivant dans la fenêtre de code de ThisWorkbook

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim R As Range
On Error Resume Next
Application.EnableEvents = False
Set R = Application.Intersect(Target, Selection.SpecialCells(xlCellTypeFormulas))
Application.EnableEvents = True
If Not R Is Nothing Then Target.Cells(1, 1).Offset(1, 0).Select
End Sub

Cordialement.

PMO
Patrick Morange

Bonjour,

Bravo et merci pour la réponse mais pour affiner est-il possible d'avoir une autre commande qui ponctuellement neutralise la formule mise en VBA car sinon impossible de modifier les formules si ce n'est que d'effacer le programme en VBA mais il doit y avoir plus rationnel.

Merci d'avance,

 

[PMO2]

Re : Protection cellules

Bonjour,

Bravo et merci pour la réponse mais pour affiner est-il possible d'avoir une autre commande qui ponctuellement neutralise la formule mise en VBA car sinon impossible de modifier les formules si ce n'est que d'effacer le programme en VBA mais il doit y avoir plus rationnel.

Veuillez suivre cette démarche

1) Copiez le code suivant dans la fenêtre de code de ThisWorkbook (il remplace l'ancien code)

Private Sub Workbook_Activate()
Application.OnKey "^!", "InverseEnableEvents"
End Sub

Private Sub Workbook_Deactivate()
Application.OnKey "^!"
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim R As Range
On Error Resume Next
Application.EnableEvents = False
Set R = Application.Intersect(Target, Selection.SpecialCells(xlCellTypeFormulas))
Application.EnableEvents = True
If Not R Is Nothing Then Target.Cells(1, 1).Offset(1, 0).Select
End Sub

2) Copiez le code suivant dans un module standard

Sub InverseEnableEvents(Optional dummy As Byte)
With Application
  .EnableEvents = Not .EnableEvents
  If .EnableEvents Then
    .StatusBar = False
  Else
    .StatusBar = "Evènements désactivés"
  End If
End With
End Sub

Chaque fois que vous ferez Ctrl (touche maintenue) et !
les évènements seront tour à tour désactivés ou activés et apparaîtra respectivement, dans la barre des tâches,
"Evènements désactivés" ou "Prêt"

Cordialement.

PMO
Patrick Morange

 

[mcj1997]

Re : Protection cellules

Bonjour,



Veuillez suivre cette démarche

1) Copiez le code suivant dans la fenêtre de code de ThisWorkbook (il remplace l'ancien code)

Private Sub Workbook_Activate()
Application.OnKey "^!", "InverseEnableEvents"
End Sub

Private Sub Workbook_Deactivate()
Application.OnKey "^!"
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim R As Range
On Error Resume Next
Application.EnableEvents = False
Set R = Application.Intersect(Target, Selection.SpecialCells(xlCellTypeFormulas))
Application.EnableEvents = True
If Not R Is Nothing Then Target.Cells(1, 1).Offset(1, 0).Select
End Sub

2) Copiez le code suivant dans un module standard

Sub InverseEnableEvents(Optional dummy As Byte)
With Application
  .EnableEvents = Not .EnableEvents
  If .EnableEvents Then
    .StatusBar = False
  Else
    .StatusBar = "Evènements désactivés"
  End If
End With
End Sub

Chaque fois que vous ferez Ctrl (touche maintenue) et !
les évènements seront tour à tour désactivés ou activés et apparaîtra respectivement, dans la barre des tâches,
"Evènements désactivés" ou "Prêt"

Cordialement.

PMO
Patrick Morange

Bonjour,

Merci et encore bravo très fort.

Meilleurs voeux pour 2010

 

[mcj1997]

Re : Protection cellules (erreur dans thisworkbook)

Bonjour,

Merci et encore bravo très fort.

Meilleurs voeux pour 2010

Bonjour,

J'ai voulu intégrer votre formule dans un fichier dans le ThisWorkbook mais lorsque je ferme mon fichier j'ai le message d'erreur suivant : "erreur de compilation. Seuls des commentaires peuvent apparaître après End Sub, End Function, ou End Property"

et voici en entier ce que j'ai dans le Thisworkbook :

Private Sub Workbook_Open() '

Dim Bouton As CommandBarButton

Set CmdBar = Application.CommandBars _
.Add(Name:="MaBarrePerso", Position:=msoBarTop, _
Temporary:=True)

Set Bouton = CmdBar.Controls.Add(Type:=msoControlButton)
With Bouton
.FaceId = 6852
.OnAction = "SOMMAIRE"
.TooltipText = "SOMMAIRE"
.Caption = "SOMMAIRE"
.Style = msoButtonIconAndCaption

End With
CmdBar.Visible = True
End Sub





Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.CommandBars("MaBarrePerso").Delete
End Sub

Option Explicit

Private Sub Workbook_Activate()
Application.OnKey "^!", "InverseEnableEvents"
End Sub

Private Sub Workbook_Deactivate()
Application.OnKey "^!"
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim R As Range
On Error Resume Next
Application.EnableEvents = False
Set R = Application.Intersect(Target, Selection.SpecialCells(xlCellTypeFormulas))
Application.EnableEvents = True
If Not R Is Nothing Then Target.Cells(1, 1).Offset(1, 0).Select
End Sub



c'est la ligne "Private Sub Workbook_BeforeClose(Cancel As Boolean) " qui ressort en erreur (flêche jaune en début de ligne et soulignement en jaune.

Merci d'avance,

 

[mcj1997]

Re : Protection cellules (erreur dans thisworkbook)

Bonjour,

J'ai voulu intégrer votre formule dans un fichier dans le ThisWorkbook mais lorsque je ferme mon fichier j'ai le message d'erreur suivant : "erreur de compilation. Seuls des commentaires peuvent apparaître après End Sub, End Function, ou End Property"

et voici en entier ce que j'ai dans le Thisworkbook :

Private Sub Workbook_Open() '

Dim Bouton As CommandBarButton

Set CmdBar = Application.CommandBars _
.Add(Name:="MaBarrePerso", Position:=msoBarTop, _
Temporary:=True)

Set Bouton = CmdBar.Controls.Add(Type:=msoControlButton)
With Bouton
.FaceId = 6852
.OnAction = "SOMMAIRE"
.TooltipText = "SOMMAIRE"
.Caption = "SOMMAIRE"
.Style = msoButtonIconAndCaption

End With
CmdBar.Visible = True
End Sub





Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.CommandBars("MaBarrePerso").Delete
End Sub

Option Explicit

Private Sub Workbook_Activate()
Application.OnKey "^!", "InverseEnableEvents"
End Sub

Private Sub Workbook_Deactivate()
Application.OnKey "^!"
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim R As Range
On Error Resume Next
Application.EnableEvents = False
Set R = Application.Intersect(Target, Selection.SpecialCells(xlCellTypeFormulas))
Application.EnableEvents = True
If Not R Is Nothing Then Target.Cells(1, 1).Offset(1, 0).Select
End Sub



c'est la ligne "Private Sub Workbook_BeforeClose(Cancel As Boolean) " qui ressort en erreur (flêche jaune en début de ligne et soulignement en jaune.

Merci d'avance,

Bonjour,

Je reviens pour la même question pour laquelle je n'ai rien reçu, n'y a-t-il pas quelqu'un qui puisse m'aider ?

Merci d'avance,