Makro ile Kopyala/Yapıştır - Sürükle/Bırak Hata

[dnmtnk]

Arkadaşlar daha önce hazırladığım bir kod vardı sadece kopyala yapıştırmayı engelliyordum fakat sürükle/bırak komutunu da engellemem gerekti bu 2 komutu aynı anda kullanınca kopyala/yapıştır pasif olmuyor hata mı yapıyorum yoksa yanlış kod mu kullanıyorum yardımcı olabilir misiniz rica etsem...

Kodlar

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

If Sheets("Sayfa1").Range("A1") = "" Then Call Boş
If Sheets("Sayfa1").Range("A1") <> "" Then Call Dolu

End Sub

Private Sub Boş()
    
    Application.CutCopyMode = False
    Application.CellDragAndDrop = False
    Application.OnKey "^c", ""
    Application.OnKey "^d", ""
    Application.OnKey "^v", ""

End Sub

Private Sub Dolu()

    Application.CutCopyMode = True
    Application.CellDragAndDrop = True
    Application.OnKey "^c", ""
    Application.OnKey "^d", ""
    Application.OnKey "^v", ""

End Sub

A1 boşsa kopyala yapıştır ve sürükle bırak yasak olsun
A1 doluysa kopyala yapıştır ve sürükle bırak kullanılsın

 

[Murat OSMA]

Merhaba,

• Dosyanızı kapatın.
• Yeniden açın.
• Herhangi bir hücre seçmeden ALT + F11'e basın ve VBE Penceresine gidin.
• ThisWorkbook(BuÇalışmaKitabı) kod kısmındaki kodları silin.
• Bu kodları yapıştırıp deneyin.

[SIZE="2"]Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Sheets("Sayfa1").Range("A1") = "" Then Call Boş
    If Sheets("Sayfa1").Range("A1") <> "" Then Call Dolu
End Sub

Private Sub Boş()
    Application.CutCopyMode = False
    Application.CellDragAndDrop = False
    For Each Copy In Application.CommandBars.FindControls(ID:=19)
        Copy.Enabled = False
    Next Copy
End Sub

Private Sub Dolu()
    If Application.CellDragAndDrop = False Then Application.CellDragAndDrop = True
    For Each Copy In Application.CommandBars.FindControls(ID:=19)
        Copy.Enabled = True
    Next Copy
End Sub[/SIZE]

 

[dnmtnk]

Murat bey, verdiğiniz kodlar çalıştı. Teşekkür ederim. Sakıncası yoksa ve vaktiniz varsa iki kod arasındaki farkı yazmanız mümkün mü? Yani diğer yazdığım kod neden çalışmadı fakat sizin verdiğiniz kodlar çalıştı? Mantığı nedir onu da öğrenmek isterim. İyi çalışmalar.

 

[Murat OSMA]

Çok fazla zamanım yok.
Siz Ctrl c,d,v yi hafızadan tamamen siliyorsunuz, daha sonra geri getirmiyorsunuz.


İyi günler.

Not: Lütfen son gönderdiğiniz mesajınızdaki gereksiz alıntıyı siler misiniz?
Bir önceki mesajdan tamamen olduğu gibi alıntı yapmanıza gerek yok, ayrıca görüntü kirliliğine sebep oluyor.
​

 

[Korhan Ayhan]

Sizin kodlarınız da aşağıdaki gibi olunca çalışıyor.

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Sheets("Sayfa1").Range("A1") = "" Then Call Boş
    If Sheets("Sayfa1").Range("A1") <> "" Then Call Dolu
End Sub

Private Sub Boş()
    Application.CutCopyMode = False
    Application.CellDragAndDrop = False
    Application.OnKey "^c", ""
    Application.OnKey "^d", ""
    Application.OnKey "^v", ""
End Sub

Private Sub Dolu()
    If Application.CutCopyMode = False Then Application.CutCopyMode = True
    If Application.CellDragAndDrop = False Then Application.CellDragAndDrop = True
    Application.OnKey "^c"
    Application.OnKey "^d"
    Application.OnKey "^v"
End Sub

 

[dnmtnk]

Murat bey ve Korhan bey verdiğiniz bilgiler için teşekkür ederim. İyi çalışmalar dilerim.