Re: Copier/coller & verrouillage
Complément : j'ai trouvé sur le net ces codes qui semblent faire l'affaire, mais malheureusement, quand je fais un copier/coller, la valeur s'affiche bien mais un petit carré s'affiche à la suite, et aussi quelques espaces.
Quelqu'un saurait-il corriger ?
merci.
Thombar
Placer ce code dans Thisworkbook :
Private Sub Workbook_Activate()
If ActiveSheet.Name = "Sheet1" Then
Call DisablePaste
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call DisablePaste
End Sub
Private Sub Workbook_Open()
Call EnablePaste
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name = "Sheet1" Then
Call DisablePaste
Else
Call EnablePaste
End If
End Sub
Private Sub Workbook_WindowDeactivate(ByVal Wn As Excel.Window)
Call EnablePaste
End Sub
_________________________________________________
Placer ce code dans un module :
Option Explicit
Dim Ctrl, i
Dim Cpy As DataObject
Sub DisablePaste()
'Divert Copy command to your macro
'You need to divert away from copy STD due to the fact that
'the user can still copy and paste via COPY then press ENTER !!
Application.CommandBars("Edit").Controls.Item("Copy").OnAction = "SimCopy"
'Divert Paste to your macro to simulate a paste by Val
Application.CommandBars("Edit").Controls.Item("Paste").OnAction = "NoNo"
'Disable Paste Special & Paste as Hyperlink buttons
Application.CommandBars("Edit").Controls.Item("Paste Special...").Enabled = False
Application.CommandBars("Edit").Controls.Item("Paste as Hyperlink").Enabled = False
'Disable ALL Paste & Copy buttons on commandbars where ever they may be
For Each Ctrl In CommandBars
For Each i In Ctrl.Controls
If InStr(1, i.Caption, "Paste", 1) + InStr(1, i.Caption, "Copy", 1) <> 0 Then
With CommandBars(Ctrl.Name)
i.Enabled = False
End With
End If
Next
Next
'Disable right click on Sheet Cells which also gives you option to paste & Copy
Application.CommandBars("Cell").Enabled = False
'Divert "Ctrl V" KEY: Note small v NOT CAPITAL V
Application.OnKey "^{v}", "NoNo"
End Sub
Sub EnablePaste()
Application.CommandBars("Edit").Controls.Item("Copy").OnAction = ""
'Enable Paste, Paste Special & Paste as Hyperlink buttons
Application.CommandBars("Edit").Controls.Item("Paste").OnAction = ""
Application.CommandBars("Edit").Controls.Item("Paste Special...").Enabled = True
Application.CommandBars("Edit").Controls.Item("Paste as Hyperlink").Enabled = True
'Enable all Paste & Copy buttons on commandbars
For Each Ctrl In CommandBars
For Each i In Ctrl.Controls
If InStr(1, i.Caption, "Paste", 1) + InStr(1, i.Caption, "Copy", 1) <> 0 Then
With CommandBars(Ctrl.Name)
i.Enabled = True
End With
End If
Next
Next
'Enable right click on Sheet Cells which also gives you option to paste
Application.CommandBars("Cell").Enabled = True
'Divert "Ctrl V" KEY
Application.OnKey "^{v}", ""
End Sub
Sub NoNo()
Cpy = New DataObject ' IL MANQUAIT CETTE LIGNE A LA MACRO D'ORIGINE, CELA FAISAIT UNE ERREUR. J'IGNORE SI J'AI BIEN FAIT
MsgBox "Pasting Values only"
Cpy.GetFromClipboard
Selection = Cpy.GetText(1)
End Sub
Sub SimCopy()
Set Cpy = New DataObject
'Usiing the clipboard directly eliminates the problem you get
'when you copy STD ie. you are able to Paste via pressing ENTER !!
Cpy.SetText Selection
Cpy.PutInClipboard
End Sub