ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: wb169646

EXCEL2010禁用复制粘贴功能VBA代码分享

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2018-6-7 11:05 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
zxasdqwer887 发表于 2017-6-13 16:22
application.CutCopyMode = False 搞定了

请问:这句代码的意思和功能是?
         将这句代码放在那里?
  谢谢!

TA的精华主题

TA的得分主题

发表于 2018-6-7 11:08 | 显示全部楼层
另外,经过网上学习,进行了简单的翻译解释,不知对否,请高手指正。谢谢。

'*** 在标准模块中的代码 ***
Option Explicit        '选项显示方式

Sub ToggleCutCopyAndPaste(Allow As Boolean)
     '激活/禁用 cut(剪切), copy(复制), paste(粘贴) 和 pastespecial(选择性粘贴)
    Call EnableMenuItem(21, Allow)    '调用cut(剪切)
    Call EnableMenuItem(19, Allow)    '调用copy(复制)
    Call EnableMenuItem(22, Allow)    '调用paste(粘贴)
    Call EnableMenuItem(755, Allow)   '调用pastespecial(选择性粘贴)
     
     '激活/禁用拖放功能
    Application.CellDragAndDrop = Allow
     
     '激活/禁用 cut(剪切), copy(复制), paste(粘贴) 和 pastespecial(选择性粘贴)
    With Application
        Select Case Allow     '允许选择
        Case Is = False       '为假
            .OnKey "^c", "CutCopyPasteDisabled"          '"Ctrl+c"复制快捷键无效,并通知用户
            .OnKey "^v", "CutCopyPasteDisabled"          '"Ctrl+v"粘贴快捷键无效,并通知用户
            .OnKey "^x", "CutCopyPasteDisabled"          '"Ctrl+x"剪切快捷键无效,并通知用户
            .OnKey "+{DEL}", "CutCopyPasteDisabled"      '"+{DEL}"删除快捷键无效,并通知用户
            .OnKey "^{INSERT}", "CutCopyPasteDisabled"   '"Ctrl+{INSERT}"插入快捷键无效,并通知用户
        Case Is = True           '为真
            .OnKey "^c"          '"Ctrl+c"复制快捷键有效
            .OnKey "^v"          '"Ctrl+v"粘贴快捷键有效
            .OnKey "^x"          '"Ctrl+x"剪切快捷键有效
            .OnKey "+{DEL}"      '"+{DEL}"删除快捷键有效
            .OnKey "^{INSERT}"   '"Ctrl+{INSERT}"插入快捷键有效
        End Select               '结束选择
    End With
End Sub

Sub EnableMenuItem(ctlId As Integer, Enabled As Boolean)     '激活/禁用向下拖动填充
    Dim cBar As CommandBar                    '声明变量
    Dim cBarCtrl As CommandBarControl
    For Each cBar In Application.CommandBars
        If cBar.Name <> "Clipboard" Then
            Set cBarCtrl = cBar.FindControl(ID:=ctlId, recursive:=True)
            If Not cBarCtrl Is Nothing Then cBarCtrl.Enabled = Enabled
        End If
    Next
End Sub

Sub CutCopyPasteDisabled()   '通知用户功能已被禁用
    MsgBox "对不起!本工作簿中已禁用剪切、复制和粘贴!"
End Sub


'*** 在ThisWorkbook模块中的代码 ***

Option Explicit                    '选项显示方式

Private Sub Workbook_Activate()          '激活
    Call ToggleCutCopyAndPaste(False)
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)      '关闭前
    Call ToggleCutCopyAndPaste(True)
End Sub

Private Sub Workbook_Deactivate()        '退出时
    Call ToggleCutCopyAndPaste(True)     '恢复   
End Sub

Private Sub Workbook_Open()              '启动时
    Call ToggleCutCopyAndPaste(False)    '禁用   
End Sub

TA的精华主题

TA的得分主题

发表于 2018-6-7 11:28 | 显示全部楼层
英文不懂,通过网上学习,进行了简单的翻译和解释,不知对否,请高手指正并补充完善。谢谢!

'*** 在标准模块中的代码 ***

Option Explicit        '选项显示方式

Sub ToggleCutCopyAndPaste(Allow As Boolean)
     '激活/禁用 cut(剪切), copy(复制), paste(粘贴) 和 pastespecial(选择性粘贴)
    Call EnableMenuItem(21, Allow)    '调用cut(剪切)
    Call EnableMenuItem(19, Allow)    '调用copy(复制)
    Call EnableMenuItem(22, Allow)    '调用paste(粘贴)
    Call EnableMenuItem(755, Allow)   '调用pastespecial(选择性粘贴)
     
     '激活/禁用拖放功能
    Application.CellDragAndDrop = Allow
     
     '激活/禁用 cut(剪切), copy(复制), paste(粘贴) 和 pastespecial(选择性粘贴)
    With Application
        Select Case Allow     '允许选择
        Case Is = False       '为假
            .OnKey "^c", "CutCopyPasteDisabled"          '"Ctrl+c"复制快捷键无效,并通知用户
            .OnKey "^v", "CutCopyPasteDisabled"          '"Ctrl+v"粘贴快捷键无效,并通知用户
            .OnKey "^x", "CutCopyPasteDisabled"          '"Ctrl+x"剪切快捷键无效,并通知用户
            .OnKey "+{DEL}", "CutCopyPasteDisabled"      '"+{DEL}"删除快捷键无效,并通知用户
            .OnKey "^{INSERT}", "CutCopyPasteDisabled"   '"Ctrl+{INSERT}"插入快捷键无效,并通知用户
        Case Is = True           '为真
            .OnKey "^c"          '"Ctrl+c"复制快捷键有效
            .OnKey "^v"          '"Ctrl+v"粘贴快捷键有效
            .OnKey "^x"          '"Ctrl+x"剪切快捷键有效
            .OnKey "+{DEL}"      '"+{DEL}"删除快捷键有效
            .OnKey "^{INSERT}"   '"Ctrl+{INSERT}"插入快捷键有效
        End Select               '结束选择
    End With
End Sub

Sub EnableMenuItem(ctlId As Integer, Enabled As Boolean)     '激活/禁用向下拖动填充
    Dim cBar As CommandBar                    '声明变量
    Dim cBarCtrl As CommandBarControl
    For Each cBar In Application.CommandBars
        If cBar.Name <> "Clipboard" Then
            Set cBarCtrl = cBar.FindControl(ID:=ctlId, recursive:=True)
            If Not cBarCtrl Is Nothing Then cBarCtrl.Enabled = Enabled
        End If
    Next
End Sub

Sub CutCopyPasteDisabled()   '通知用户功能已被禁用
    MsgBox "对不起!本工作簿中已禁用剪切、复制和粘贴!"
End Sub


'*** 在ThisWorkbook模块中的代码 ***

Option Explicit                    '选项显示方式

Private Sub Workbook_Activate()          '激活
    Call ToggleCutCopyAndPaste(False)
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)      '关闭前
    Call ToggleCutCopyAndPaste(True)
End Sub

Private Sub Workbook_Deactivate()        '退出时
    Call ToggleCutCopyAndPaste(True)     '恢复
End Sub

Private Sub Workbook_Open()              '启动时
    Call ToggleCutCopyAndPaste(False)    '禁用
End Sub


TA的精华主题

TA的得分主题

发表于 2018-9-2 18:36 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-8-19 23:14 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2020-9-4 21:45 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2020-10-7 13:43 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2021-8-14 20:17 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
试了下,右键菜单上的复制剪切确实不能用了,但菜单上的复制剪切还是可以用的。

TA的精华主题

TA的得分主题

发表于 2022-8-11 22:39 | 显示全部楼层
hanzhang98 发表于 2018-6-7 11:28
英文不懂,通过网上学习,进行了简单的翻译和解释,不知对否,请高手指正并补充完善。谢谢!

'*** 在标 ...

如果只允许使用选择性粘贴-数值功能,怎么改代码呢

TA的精华主题

TA的得分主题

发表于 2022-10-10 10:12 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
感谢楼主分享!!!
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

最新热点上一条 /1 下一条

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-4-25 07:07 , Processed in 0.042622 second(s), 8 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表