empêcher glisser déplacer

[cricri62]

bonjour à tous

j'aimerais interdire le glisser déplacer dans certaines feuilles ou dans certaines zones de la feuille mais pas à travers outils /options. existe-il une solution

 

[Laurent L]

Bonjour,

Le code ci-dessous montre comment bloquer le glisser-déplacer pour une feuille de calcul particulère. A adapter si tu veux bloquer seulement certaines plages...

' *** Dans le module ThisWorkbook ***

Private Sub Workbook_Open()
  Dim Sht As Worksheet
  Set Sht = ActiveSheet
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    ' Remplacer Feuil1 par le nom de module de la feuille à bloquer
    Feuil1.Activate
    Feuil1.Init ActiveWindow.RangeSelection
    Sht.Activate
    .ScreenUpdating = True
    .EnableEvents = True
  End With
End Sub

' *** Dans le module de la feuille de calcul ***

Dim P As Range
Dim A As String

Private Sub Worksheet_Change(ByVal Target As Range)
   If P.Address <> A Then
      Application.EnableEvents = False
      Application.Undo
      Application.EnableEvents = True
   End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Init Target
End Sub

Public Sub Init(T As Range)
   Set P = T
   A = P.Address
End Sub

Cordialement,

Laurent

 

[tibel6]

Re : empêcher glisser déplacer

Bonjour,
Je cherche à généraliser le code ci-dessus à toutes les feuilles de mon classeur. Quelqu'un voit-il un moyen pour y arriver ?

PS : je suis nul en VBA alors j'ai vraiment besoin de votre savoir-faire !

 

[JNP]

Re : empêcher glisser déplacer

Bonjour Tibel6 ,
A priori :

' *** Dans le module ThisWorkbook ***
Private Sub Workbook_Open()
    Init Selection
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Init Selection
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   If P.Address <> A Then
      Application.EnableEvents = False
      Application.Undo
      Application.EnableEvents = True
   End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
   Init Target
End Sub
Private Sub Workbook_WindowActivate(ByVal Wn As Window)
    Init Selection
End Sub

' *** Dans un module standard ***
Public P As Range
Public A As String
Public Sub Init(T As Range)
   Set P = T
   A = P.Address
End Sub

semble fonctionner ...
Bonne suite

 

[tibel6]

Re : empêcher glisser déplacer

J'ai trouvé une solution pas très élégante en enlevant "Feuill1" dans le module ThisWorkbook et en copiant le code de feuille dans chaque feuille. Etant donné que j'ai une centaine de feuilles c'est un peu fastidieux mais on y arrive ! Ca n'est néanmoins toujours pas idéal dans le sens où si on ajoute une nouvelle feuille il faut bien penser à rajouter le code.
Si quelqu'un a quelque chose de plus élégant je suis toujours preneur !!
Cordialement,
Tibel6

 

[tibel6]

Re : empêcher glisser déplacer

Bonjour JNP,
Merci beaucoup pour votre aide ! Cela marche parfaitement.

Bien cordialement,
Tibel6