Xin code khóa copy, cut, cell drag&drop 1 hay nhiều vùng chọn độc lập khác nhau VBA (1 người xem)

[baby_mith]

Kính chào anh/chị.
Hiện tại em đang dùng chức năng Data Validation để quản lí list danh sách được phép nhập liệu, do bản tính được chia sẻ với nhiều người mà toàn trình độ tin học không tốt...nhập liệu sai tùm lum, nên mỗi lần check rất mệt...data lớn. @@.
Chức năng Data Validation nếu dùng với protect sheet thì không nhập liệu được. Nên em nghĩ đến cái ý tưởng khóa cell tùy biện mà vẫn nhập liệu được.
Lên mạng mò mẫm kiếm được cái code của anh Hai Lúa Miền Tây diễn đàn của mình:

Private Sub Worksheet_Activate()
Dim oCtrl As Office.CommandBarControl
For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
oCtrl.Enabled = False
Next oCtrl

For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
oCtrl.Enabled = False

Next oCtrl
Application.CellDragAndDrop = False
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Application
.CellDragAndDrop = False
.CutCopyMode = False
End With
End Sub

Code rất hay tuy nhiên lại khóa hết chức năng copy, paste, cell drag and drop....Nên kính nhờ anh chị diễn đàn mình ai nghiên cứu sâu VBA thì cho em xin đoạn code chỉ khóa cho vùng chọn (Range).
VD: Khóa copy,cut, cell drag&drop vùng A11 & A510 chẳng hạn.Các vùng khác vẫn bình thường. Thật tế em có cở 100 vùng chọn.

Trân Trọng,

 

[nmhung49]

Code rất hay tuy nhiên lại khóa hết chức năng copy, paste, cell drag and drop....Nên kính nhờ anh chị diễn đàn mình ai nghiên cứu sâu VBA thì cho em xin đoạn code chỉ khóa cho vùng chọn (Range).
VD: Khóa copy,cut, cell drag&drop vùng A11 & A510 chẳng hạn.Các vùng khác vẫn bình thường. Thật tế em có cở 100 vùng chọn.

Trân Trọng,

Thử với code này thay đổi vùng trong union thích hợp
[GPECODE=vb]
Private Sub Worksheet_Change(ByVal Target As Range)
With Application
If Not .Intersect(Target, .Union([A11], [A510])) Is Nothing Then
.CellDragAndDrop = False
.CutCopyMode = False
End If
End With
End Sub


[/GPECODE]

 

[baby_mith]

Thử với code này thay đổi vùng trong union thích hợp
[GPECODE=vb]
Private Sub Worksheet_Change(ByVal Target As Range)
With Application
If Not .Intersect(Target, .Union([A11], [A510])) Is Nothing Then
.CellDragAndDrop = False
.CutCopyMode = False
End If
End With
End Sub


[/GPECODE]

Cảm ơn anh, tuy nhiên không ổn anh ơi. Code của anh chưa nhập liệu thì mọi thứ bình thường. Nhập xong rùi bị khóa hết à.
Ý của em là các vùng khác bình thường, vùng chọn thì vẫn nhập liệu được, tuy nhiên các thao tác: copy,cut,cell drag,delete ô đó bị cấm tuyệt đối.

 

[Quang_Hải]

Cảm ơn anh, tuy nhiên không ổn anh ơi. Code của anh chưa nhập liệu thì mọi thứ bình thường. Nhập xong rùi bị khóa hết à.
Ý của em là các vùng khác bình thường, vùng chọn thì vẫn nhập liệu được, tuy nhiên các thao tác: copy,cut,cell drag,delete ô đó bị cấm tuyệt đối.

Cũng không hiểu ý lắm nhưng cứ thử thế này
Copy hết code này vào sheet cần

Option Explicit
Public tam
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Union([A1:D1], [A5:D10])) Is Nothing Then
    Application.CellDragAndDrop = False
Else
   tam = Selection.Value
End If
End Sub

 

[nmhung49]

Cảm ơn anh, tuy nhiên không ổn anh ơi. Code của anh chưa nhập liệu thì mọi thứ bình thường. Nhập xong rùi bị khóa hết à.
Ý của em là các vùng khác bình thường, vùng chọn thì vẫn nhập liệu được, tuy nhiên các thao tác: copy,cut,cell drag,delete ô đó bị cấm tuyệt đối.

Vậy mình chuyển qua sự kiện chọn là thay đổi liền SelectionChange copy toàn bộ vào sheet muốn chống copy,cut, delete
[GPECODE=vb]
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Application
If Not .Intersect(Target, .Union([A11], [A510])) Is Nothing Then
.CellDragAndDrop = False
.CutCopyMode = False
.OnKey "{DEL}", "Sheet1.Thongbao" 'Sheet1 là tên sheet name chứa sự kiện
.OnKey "{BS}", "Sheet1.Thongbao"
End If
End With
End Sub
---------------------------
Sub Thongbao()
MsgBox "Khong duoc xoa"
End Sub


[/GPECODE]

 

[baby_mith]

Vậy mình chuyển qua sự kiện chọn là thay đổi liền SelectionChange copy toàn bộ vào sheet muốn chống copy,cut, delete
[GPECODE=vb]
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Application
If Not .Intersect(Target, .Union([A11], [A510])) Is Nothing Then
.CellDragAndDrop = False
.CutCopyMode = False
.OnKey "{DEL}", "Sheet1.Thongbao" 'Sheet1 là tên sheet name chứa sự kiện
.OnKey "{BS}", "Sheet1.Thongbao"
End If
End With
End Sub
---------------------------
Sub Thongbao()
MsgBox "Khong duoc xoa"
End Sub


[/GPECODE]

Em test code của anh thì có 2 vấn đề...
1. Đã đúng ý em là thay đổi sự kiện khi chọn...chọn dô vùng chọn nó khóa luôn...tuy nhiên copy trong vùng chọn ra bên ngoài dc..
2. Bên ngoài thì code không tự thay đổi ngược lại được..cũng bị khóa tút...
bạn em quăng code qua cho test mà cũng bị vậy dù giá trị là true

Private Sub Worksheet_SelectionChange(ByVal Target As Range)With ApplicationIf Not .Intersect(Target, .Union([A11], [A510])) Is Nothing Then .CellDragAndDrop = False .OnKey "^c", "" .CutCopyMode = FalseEnd If
If .Intersect(Target, .Union([A11], [A510])) Is Nothing Then .CellDragAndDrop = True .OnKey "^c", "" .CutCopyMode = TrueEnd IfEnd WithEnd Sub

 

[siwtom]

Cảm ơn anh, tuy nhiên không ổn anh ơi. Code của anh chưa nhập liệu thì mọi thứ bình thường. Nhập xong rùi bị khóa hết à.
Ý của em là các vùng khác bình thường, vùng chọn thì vẫn nhập liệu được, tuy nhiên các thao tác: copy,cut,cell drag,delete ô đó bị cấm tuyệt đối.

Ơ, không thấy bạn cấm Paste nhỉ.

Chỗ đỏ đỏ là không lôgíc. Bạn cho người ta quyền nhập dữ liệu nhưng không cho người ta quyền xóa (DELETE) thì vô lý. Thứ nhất là nếu người ta nhập sai và muốn xóa để nhập lại mà bạn cấm thì vô lý quá. Thứ nữa thì bạn hãy nghĩ xem. Bạn cấm người ta dùng phím Delete nhưng bạn cho phép người ta thao tác nhập liệu tức cho phép người ta sửa khi gõ sai. Nếu không dùng được Delete thì cũng phải cho người ta dùng phím Break, vì ngược lại thì người ta sửa sai như thế nào? Mà cho dùng Break thì khi cần xóa chuỗi 20 ký tự thì nhấn 20 lần phím Break. Kết quả cũng y như nhấn 1 lần Delete. Hoặc nếu không cho dùng cả Break thì người ta bôi đen chuỗi sai rồi gõ lại chuỗi đúng. Kết quả cũng như là nhấn Delete + gõ lại chuỗi đúng. Như vậy bạn vẫn không cấm xóa được mà lệnh cấm đó chỉ làm khổ người ta thôi. Như vậy không cho dùng Delete không là cấm xóa mà chỉ là "hành hạ" người nhập liệu mà thôi.

Làm cái gì cũng phải có chút lôgíc. Lôgíc của tôi là như trên.

Tôi không hiểu mục đích cuối cùng bạn định làm gì nhưng nếu chỉ cấm COPY + CUT + DRAG, không cấm Delete, thì thử xem code sau có đạt yêu cầu không.

Dán vào sheet mà có các vùng cấm

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    [COLOR=#ff0000]CloseClipboard[/COLOR]
    If Not Intersect(Target, Union([B][COLOR=#0000ff][C4:E9], [H8:J12][/COLOR][/B])) Is Nothing Then
        [COLOR=#ff0000]OpenClipboard 0
        EmptyClipboard[/COLOR]
        Application.CellDragAndDrop = False
    Else
        If Application.CellDragAndDrop = False Then Application.CellDragAndDrop = True
    End If
End Sub

Chỗ đỏ đỏ thay bằng vùng của bạn, có bao nhiêu thì liệt kê ra hết.

Dán vào ThisWorkbook

[COLOR=#ff0000]Private Sub Workbook_BeforeClose(Cancel As Boolean)
    CloseClipboard
End Sub[/COLOR]

Private Sub Workbook_Open()
    Sheets("Sheet1").Range("A1").Select
End Sub

Thay Sheet1 bằng tên sheet có các vùng cấm, và thay A1 bằng ô bất kỳ không thuộc các vùng cấm.

Dán vào Module1

[COLOR=#ff0000]Public Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long
Public Declare Function CloseClipboard Lib "user32.dll" () As Long
Public Declare Function EmptyClipboard Lib "user32.dll" () As Long[/COLOR]

--------------
À quên. Code muốn chống cả Paste (muốn thôi chứ chưa biết có chống được không). Nếu bạn không muốn chống Paste (vì bạn không liệt kê) thì xóa những chỗ đỏ đỏ rồi xem code còn lại có làm đúng yêu cầu của bạn không.