Kopyala - Yapıştır ve Çift Tıklama Engelleme Sorunu

[cicosz]

Merhabalar,
Çalışma kitabıma aşağıdaki kodları ekledim fakat istediğim sonucu alamadım.
İlk olarak kısayollarla ilgili durumdan bahsedeyim: Kısayollarlar işleme giriyor fakat EnableControl kısmındaki id li işlemler işleme girmiyor. Bunun testini "kes" ile yaptım. Kes işlevi EnabledControl kısmında var fakat tuş kombinasyonunda yok. Çalışma kitabı açıkken kes işlevi yerine getirilebiliyor.
İkinci olarak Çalışma kitabımda veya aktif sayfamda belirli aralıktaki hücrelerde çift tıklama işlevini kapatmak istiyorum. BeforeDoubleClick işlevini yerine getirmiyor. Buna kopyala yapıştıra engel olup metinleri özgün bir şekilde elleriyle yazarak girsinler diye istiyorum. En azından formu doldururken bir kez okumuş olurlar.

Bu iki durum için yardımlarınızı bekliyorum.
Teşekkürler.

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 "{F2}", ""
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 "{F2}"
Application.OnKey "+{DEL}"
Application.OnKey "+{INSERT}"
Application.CellDragAndDrop = True
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A1:CZ46")) Is Nothing Then Cancel = 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 "{F2}", ""
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 "{F2}"
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

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki kodu silin

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A1:CZ46")) Is Nothing Then Cancel = True
End Sub

Aşağıdaki kodu ekleyin.

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A1:CZ46")) Is Nothing Then Cancel = True
End Sub

Bir sorun daha var çözebilmek için şunu öğrenmem gerek.
Siz bu işlevlerin bütün dosyadaki sayfalarda geçerli olmasını mı istiyorsunuz yoksa sadece bir sayfada mı yada belirli bazı sayfalarda mı?

 

[cicosz]

Öncelikle teşekkürler,
Şu an için ihtiyacım tüm sayfalarda engellemek.

 

[Muzaffer Ali]

O zaman kodlarınızın tamamını silin "BuÇAlışmaKitabı" kod bölümüne aşağıdaki kodları kopyalayın.
Dosyanızı kapatıp açın kodlar aktif olacaktır.

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 "{F2}", ""
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 "{F2}"
Application.OnKey "+{DEL}"
Application.OnKey "+{INSERT}"
Application.CellDragAndDrop = True
End Sub

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A1:CZ46")) Is Nothing Then Cancel = 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

 

[cicosz]

Teşekkürler,
ctrl + x yapınca hücre kenarları kesikli hal alıyor. Yani EnableControl kısmı çalışmıyor. O bölüme başka engellemeler eklemem gerekirse diye kodda o kısmı da tutuyorum. Bununla ilgili fikriniz var mı?

 

[Muzaffer Ali]

Dikkatimden kaçmış. CTRL + x kodlarda yok onu da siz ekleyebilirsiniz.

Application.OnKey "^x", ""

 

[cicosz]

Teşekkürler,
Ctrl+x klavye kısayolunu engellemelere ekledim. Fakat EnabledControl kısmı çalışmadığından 2619 id li işlemi kısıtlayamıyorum.
Şöyle sorayım size: Ekle >> Resimler kısmını nasıl engelleyebilirim?