Örnek Kod Kopyala Yapıştır Engelleme

gicimi

Yeni Üye
Katılım
18 Haz 2018
Mesajlar
50
En İyi Yanıtlar
1
Beğeniler
28
Puanları
18
Yaş
31
Konum
Ankara
Ad Soyad
Hüseyin Yılmaz
#1
Merhaba;

Çalışma kitabının tüm sayfalarında "kopyala yapıştır" engelleme yapmak ister misiniz. Aşağıdaki kodları kullanabilirsiniz.

Kod:
Option Explicit

Private Sub Workbook_Open()
EnableControl 21, False ' cut
EnableControl 19, False ' copy
EnableControl 22, False ' paste
EnableControl 755, False ' pastespecial
Application.OnKey "^c", ""
Application.OnKey "^v", ""
Application.OnKey "+{DEL}", ""
Application.OnKey "+{INSERT}", ""
Application.CellDragAndDrop = False
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
EnableControl 21, True ' cut
EnableControl 19, True ' copy
EnableControl 22, True ' paste
EnableControl 755, True ' pastespecial
Application.OnKey "^c"
Application.OnKey "^v"
Application.OnKey "+{DEL}"
Application.OnKey "+{INSERT}"
Application.CellDragAndDrop = True
End Sub



Private Sub Workbook_SheetActivate(ByVal Sh As Object)
EnableControl 21, False ' cut
EnableControl 19, False ' copy
EnableControl 22, False ' paste
EnableControl 755, False ' pastespecial
Application.OnKey "^c", ""
Application.OnKey "^v", ""
Application.OnKey "+{DEL}", ""
Application.OnKey "+{INSERT}", ""
Application.CellDragAndDrop = False
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
EnableControl 21, True ' cut
EnableControl 19, True ' copy
EnableControl 22, True ' paste
EnableControl 755, True ' pastespecial
Application.OnKey "^c"
Application.OnKey "^v"
Application.OnKey "+{DEL}"
Application.OnKey "+{INSERT}"
Application.CellDragAndDrop = True
End Sub
Sub EnableControl(Id As Integer, Enabled As Boolean)
Dim CB As CommandBar
Dim C As CommandBarControl
For Each CB In Application.CommandBars
Set C = CB.FindControl(Id:=Id, Recursive:=True)
If Not C Is Nothing Then C.Enabled = Enabled
Next
End Sub
Aşağıdaki kodları yeni bir düğme ekleyerek ve gizleyerek çalışma sayfasında değişiklik yapabilir ve kaydedebilirsiniz.

Kod:
Sub engellemeyi_aç()
Dim sifre, parametre
sifre = "1234"
parametre = InputBox("Lütfen hücreye giriş şifresini giriniz şifre  1234 ", "uyarı!")
If parametre <> sifre Then
MsgBox "Yanlış şifre girdiniz"
Exit Sub
End If

EnableControl 21, True ' cut
EnableControl 19, True ' copy
EnableControl 22, True ' paste
EnableControl 755, True ' pastespecial
Application.OnKey "^c"
Application.OnKey "^v"
Application.OnKey "+{DEL}"
Application.OnKey "+{INSERT}"
Application.CellDragAndDrop = True
End Sub
 
Üst Alt