Interdire COUPER mais autoriser COPIER/COLLER

moonj

XLDnaute Nouveau
Bonjour à tous,
J'ai un classeur que je dois déployer à un grand nombre d'utilisateur.
J'ai protégé le classeur, protégé les feuilles et déverrouillé les cellules qui nécessite de la saisie (et il y en a pas mal).
Le problème est que j'ai énormément de formules et si on utilise le COUPER dans les cellule de saisies, les formules indique #REF.
Je souhaite donc laisser le COPIER/COLLER mais ne pas autoriser le COUPER, et aussi le déplacement de formule.

J'ai trouvé pas mal de truc sur internet ou ce forum mais sur 2007. Avec 2010, il reste encore l'icone de couper sur le bandeau.

Merci a ceux qui ont une solution...
 

don_pets

XLDnaute Occasionnel
Re : Interdire COUPER mais autoriser COPIER/COLLER

'llo,

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Application
.OnKey ("^{x}"), "" 'Combinaison de touches =CTRL+x
End With
End Sub

cela empêchera ton user de se servir de son clavier avec le ctl x


sinon pour éviter l'usage de la souris :

Private Sub Workbook_Activate()
Dim oCtrl As Office.CommandBarControl

'Disable all Cut menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
oCtrl.Enabled = False
Next oCtrl

'Disable all Copy menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
oCtrl.Enabled = False
Next oCtrl

Application.CellDragAndDrop = False

End Sub

Private Sub Workbook_Deactivate()
Dim oCtrl As Office.CommandBarControl

'Enable all Cut menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
oCtrl.Enabled = True
Next oCtrl

'Enable all Copy menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
oCtrl.Enabled = True
Next oCtrl

Application.CellDragAndDrop = True

End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
With Application
.CellDragAndDrop = False
.CutCopyMode = False 'Clear clipboard
End With
End Sub
 

moonj

XLDnaute Nouveau
Re : Interdire COUPER mais autoriser COPIER/COLLER

Merci pour votre réponse.
J'avais déjà essayer ce code mais ca ne fonctionne pas : ca empêche tout collage même pour le copier.

Du coup pour l'instant je fonctionne avec le code ci dessou, ca fonctionne pas mal, mais les menus ne sont pas désactivés. Si quelqu'un sait desactivé le menu couper sous 2010, je suis preneur.

Code:
Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
 ByVal Target As Excel.Range)

 Select Case Application.CutCopyMode
 Case Is = False
 'do nothing
 Case Is = xlCopy
 'do nothing
 Case Is = xlCut
 MsgBox "Attention : il ne faut pas utiliser l'option COUPER dans ce classeur. Vous pouvez utiliser COPIER, puis supprimer les données source.", vbExclamation
 Application.CutCopyMode = False 'clear clipboard and cancel cut
 End Select

 End Sub

 
Private Sub Workbook_Open()

     Application.CellDragAndDrop = False
    
    
End Sub

Private Sub Workbook_Activate()
 Application.CellDragAndDrop = False
 End Sub

 Private Sub Workbook_BeforeClose(Cancel As Boolean)
 Application.CellDragAndDrop = True
 End Sub

 Private Sub Workbook_Deactivate()
 Application.CellDragAndDrop = True
 End Sub
 

Excelchris

XLDnaute Nouveau
Re : Interdire COUPER mais autoriser COPIER/COLLER

'llo,

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Application
.OnKey ("^{x}"), "" 'Combinaison de touches =CTRL+x
End With
End Sub

cela empêchera ton user de se servir de son clavier avec le ctl x


sinon pour éviter l'usage de la souris :

Private Sub Workbook_Activate()
Dim oCtrl As Office.CommandBarControl

'Disable all Cut menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
oCtrl.Enabled = False
Next oCtrl

'Disable all Copy menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
oCtrl.Enabled = False
Next oCtrl

Application.CellDragAndDrop = False

End Sub

Private Sub Workbook_Deactivate()
Dim oCtrl As Office.CommandBarControl

'Enable all Cut menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
oCtrl.Enabled = True
Next oCtrl

'Enable all Copy menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
oCtrl.Enabled = True
Next oCtrl

Application.CellDragAndDrop = True

End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
With Application
.CellDragAndDrop = False
.CutCopyMode = False 'Clear clipboard
End With
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 206
Messages
2 086 216
Membres
103 158
dernier inscrit
laufin