code vba ห้ามไม่ให้คัดลอกข้อมูลมาวางลงใน excel
Posted: Mon May 28, 2018 3:48 am
เรียน อาจารย์ และ ผู้รู้ทุกท่าน ครับ
ผมมีเรื่องมาถาม ครับว่า
ผมได้เขียน code ห้ามไม่ให้ copy, cut and paste ลงใน workbook
แล้วผลก็ได้ความต้องการ แต่ยังติดที่ว่า
เมื่อ copy, cut จากที่อื่นที่ไม่ใช่ workbook เดียวกันมาวาง
มันสามารถวางได้ครับ ลบกวนช่วยเช็คดูให้หน่อยว่ายังติดตรงไหน
ผมมีเรื่องมาถาม ครับว่า
ผมได้เขียน code ห้ามไม่ให้ copy, cut and paste ลงใน workbook
แล้วผลก็ได้ความต้องการ แต่ยังติดที่ว่า
เมื่อ copy, cut จากที่อื่นที่ไม่ใช่ workbook เดียวกันมาวาง
มันสามารถวางได้ครับ ลบกวนช่วยเช็คดูให้หน่อยว่ายังติดตรงไหน
Code: Select all
Private Sub Workbook_Activate()
Dim oCtrl As Office.CommandBarControl
'Disable all Cut menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
oCtrl.Enabled = False
Next oCtrl
'Disable all Copy menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
oCtrl.Enabled = False
Next oCtrl
'Disable Paste in Edit menu
For Each oCtrl In Application.CommandBars.FindControls(ID:=22)
oCtrl.Enabled = False
Next oCtrl
'Disable Paste Special...
For Each oCtrl In Application.CommandBars.FindControls(ID:=755)
oCtrl.Enabled = False
Next oCtrl
'Disable Paste button
For Each oCtrl In Application.CommandBars.FindControls(ID:=6002)
oCtrl.Enabled = False
Next oCtrl
'Disable Tools, Options so D&D cannot be restored
For Each oCtrl In Application.CommandBars.FindControls(ID:=522)
oCtrl.Enabled = False
Next oCtrl
Application.CellDragAndDrop = False
Application.CutCopyMode = False 'Clear clipboard
End Sub
Private Sub Workbook_Deactivate()
Dim oCtrl As Office.CommandBarControl
'Enable all Cut menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
oCtrl.Enabled = True
Next oCtrl
'Enable all Copy menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
oCtrl.Enabled = True
Next oCtrl
'Enable Paste in Edit menu
For Each oCtrl In Application.CommandBars.FindControls(ID:=22)
oCtrl.Enabled = True
Next oCtrl
'Enable Paste Special...
For Each oCtrl In Application.CommandBars.FindControls(ID:=755)
oCtrl.Enabled = True
Next oCtrl
'Enable Paste button
For Each oCtrl In Application.CommandBars.FindControls(ID:=6002)
oCtrl.Enabled = True
Next oCtrl
'Enable Tools, Options so D&D cannot be restored
For Each oCtrl In Application.CommandBars.FindControls(ID:=522)
oCtrl.Enabled = True
Next oCtrl
Application.CellDragAndDrop = True
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
With Application
.CellDragAndDrop = False
.CutCopyMode = False 'Clear clipboard
End With
End Sub