Seçili Sütun Üzerinde Kopyala Yapıştır ve Sürükle Bırak İşlemi Yasaklama

[kayaraydin61]

Merhaba,

Yazmakta olduğum bir makro üzerinde bir yerde tıkandım, yardımcı olursanız sevinirim.
E ve F sütununda kendim veri doğrulama ile veri girişi yaptım. Fakat dosyayı gönderdiğim kişiler, bu formatı çok kolay ve çabuk bir şekilde bozuyor. Bunun en büyük etkeni; diğer hücrelerdeki değerleri kopyala yapıştır ile yapıştırıp E ve F sütununda bulunan hücreyi bozma ya da bir sağındaki ya da bir solundaki hücreyi sürükle - bırak ile bozma şeklinde oluyor.

Ben de bir kod yazıp bu durumu sorgulamak istiyorum. Algoritma şu şekilde olacak;

1. eğer range("E:F") seçili ise (sonuçta mouse ile ya da yön kombinasyonları ile orayı seçmek zorunda); yapıştırmaya izin verme
2. eğer tut-sürükle işlemi range("E:F") ile çakışırsa, hücrenin içeriğini değiştirmeden durdur (bu biraz zor, o yüzden opsiyonel. Olmadı tut sürükleyi devre dışı bırakırım)

Mühim olan ilk isteğimin çalışması.

Diğer yerlerde tut sürükle ve kopyala yapıştırın çalışması gerekiyor. Sadece E ve F sütununda veri doğrulama ile dropdown listesi üzerinden seçim yaptırdığım için onları ezmeyecek bir kural atamam gerekiyor.

Yardımlarınız için teşekkürler...

 

[Muzaffer Ali]

Merhaba.

Sayfanızın kod bölümüne aşağıdaki kodları kopyalayın.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(ActiveCell, Range("E:F")) Is Nothing Then Exit Sub
    Cancel = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(ActiveCell, Range("E:F")) Is Nothing Then
        Application.OnKey "{F2}"
        Application.OnKey "^{c}"
        Application.OnKey "^{v}"
        Application.OnKey "^{x}"
    Else
        Application.OnKey "{F2}", ""
        Application.OnKey "^{c}", ""
        Application.OnKey "^{v}", ""
        Application.OnKey "^{x}", ""
    End If
End Sub

Yalnız bu kodlar sürükle bırak işlemine engel olamaz.
Sürükle bırak işleminin belli bazı hücreler için değil de tüm sayfa için uygulanmasını isterseniz aşağıdaki kodları da sayfaya ilave ediniz.

Private Sub Worksheet_Activate()
    Application.CellDragAndDrop = False
End Sub

Private Sub Worksheet_Deactivate()
    Application.CellDragAndDrop = True
End Sub

 

[kayaraydin61]

Merhaba.

Sayfanızın kod bölümüne aşağıdaki kodları kopyalayın.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(ActiveCell, Range("E:F")) Is Nothing Then Exit Sub
    Cancel = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(ActiveCell, Range("E:F")) Is Nothing Then
        Application.OnKey "{F2}"
        Application.OnKey "^{c}"
        Application.OnKey "^{v}"
        Application.OnKey "^{x}"
    Else
        Application.OnKey "{F2}", ""
        Application.OnKey "^{c}", ""
        Application.OnKey "^{v}", ""
        Application.OnKey "^{x}", ""
    End If
End Sub

Yalnız bu kodlar sürükle bırak işlemine engel olamaz.
Sürükle bırak işleminin belli bazı hücreler için değil de tüm sayfa için uygulanmasını isterseniz aşağıdaki kodları da sayfaya ilave ediniz.

Private Sub Worksheet_Activate()
    Application.CellDragAndDrop = False
End Sub

Private Sub Worksheet_Deactivate()
    Application.CellDragAndDrop = True
End Sub

Çok teşekkürler. Çok makbule geçti