网络教程不成功，为什么？“禁止Excel工作薄文件被拷贝复制的方法”

jaco0420

以下为百度搜到的方法。
手打，难免有代码打错，附原文。http://www.360doc.com/content/13/1001/08/4299739_318326162.shtml

禁止Excel工作薄文件被拷贝复制的方法

平时我们可以用鼠标右键中的复制粘贴来拷贝任何一个或多个文件。在Excel中，如果想要禁止Excel文件被拷贝复制，即不能使用复制粘贴来拷贝一个工作簿，没有绝对的办法，只有相对的办法。

比如，不允许使用复制粘贴功能将Excel文件从电脑A复制到电脑B，那么我们如何能做到这种效果呢？

方法是有的，但是只能气道无法使用的目的，并非真正的防止复制粘贴目的。

一、理论根据

首先我们通过VBA代码，获取电脑A上的硬盘序列号，将其保存在Excel工作薄中的第一个工作表的某个单元格内，然后，再通过VBA代码，添加工作薄打开的事件，再次获取电脑上的硬盘序列号，对比单元格内的值，如集两值相同，说明是同一台电脑，允许打开并使用工作薄，如果不相同，说明，该文件已被复制到其它脑使用，那么，就通过VBA代码将工作薄关闭。
  因为每台电脑的硬盘序列号都是不相同的，事先就将当前的电脑比如电脑A的序列号，保存到工作表望面了，而以后每次打开工作薄，都获取硬盘序列号来和该单元格内的序列号相比，如果相同，则为同台电脑，不相同则为另外的电脑，这说明已经被复制到其他的电脑使用了，这就通过VBA代码关闭工作簿，不允许用户使用即可。

二、实现方法

首先新建一个工作簿，将其保存到你的电脑中的任何位置。接着，给你这个工作簿添加如下事件的代码：

PrivateSub Worksheet_selectionchange(ByVal target As Range)

DimMyDiskCode

Setmydiskcode =getobject("winmgmts:").instancesOf("Win32_DiskDrive")

ForEach mo In MyDiskCode

  Sheet1.Cells(999,256).Value =mo.Model

Next

EndSub

如上的代码功能是，将当前电脑的序列号，保存在第999行第256列的单元格内。

记住，事件代码别错了，是这个Worksheet_SelectionChange.然后，返回到工作表1；随便点击任何一个单元格，这样第999行第256列的单元格的值就变成硬盘序列号的内容了，之后，就将如上代码除.记住，删除如上代码不再使用.

最后，就进入到每次打开工作薄用来判断硬盘序列号是否与第999行第256列的单元格内的值一致的代码了，代码如下；

PrivateSub Worksheet_Open()

DimMyDiskCode

SetMyDiskCode=GetObject("winmgmts:").instancesOf("Win32_DiskDrive")

ForEach mo In MyDiskCode

MyNewCode=mo.Model

Next

If(MyNewCode <>Trim(Sheet1.Cell (999,256).Value))Then

  ThisWorkbook.Close

EndIf

注意，如上代码的时间是工作簿的打开时间，为WorkBook_Open，你可别弄错了哦，而如下代码

If (MyNewCode<> Trim (Sheet1.Cells(999,256).Value))Then

  ThisWorkbook.Close

EndIf

是用来对比判断硬盘序列号是否一致的代码，如果不一致，就通过ThisWorkbook.Close语句关闭工作簿。

看懂了，你就可以试试了，试好了之后，把工作簿文件复制到其他电脑，然后双击打开试试，你就看到效果了。经本站测试，代码成功无误，希望对你有帮助。

分割线——————————————————

我试了可以显示硬盘序列号

但后面输入代码 ，应该也没错吧

但就是复制到其他电脑就是不能实现关闭的功能。
附我做的工作簿，
工作簿1.zip (10.49 KB, 下载次数: 10)

2019-8-28 15:00 上传

点击文件名下载附件

求大神指出我哪里错了。