gicimi
Yeni Üye
- Katılım
- 18 Haz 2018
- Mesajlar
- 64
- En iyi yanıt
- 0
- Puanları
- 18
- Yaş
- 36
- Konum
- Ankara
- Ad Soyad
- Hüseyin Yılmaz
- Office Vers.
- Office 2016 Pro
Merhaba;
Çalışma kitabının tüm sayfalarında "kopyala yapıştır" engelleme yapmak ister misiniz. Aşağıdaki kodları kullanabilirsiniz.
Aşağıdaki kodları yeni bir düğme ekleyerek ve gizleyerek çalışma sayfasında değişiklik yapabilir ve kaydedebilirsiniz.
Ç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 SubAş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
