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

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

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

　　方法是有的，但是只能使用VBA来实现，而所能实现的结果，只能起到无法使用的目的，并非真正的防止复制粘贴目的。

　　一、理论根据

　　首先我们通过VBA代码，获取电脑A上的硬盘序列号，将其保存在Excel工作薄中的第一个工作表的某个单元格内，然后，再通过VBA代码，添加工作薄打开的事件，再次获取电脑上的硬盘序列号，对比单元格内的值，如果两值相同，说明是同一台电脑，允许打开并使用工作薄，如果不相同，说明，该文件已被复制到其它电脑使用，那么，就通过VBA代码将工作薄关闭。

　　因为每台电脑的硬盘序列号都是不相同的，事先就将当前的电脑比如电脑A的序列号，保存到工作表里面了，而以后每次打开工作薄，都获取硬盘序列号来和该单元格内的序列号相比，如果相同，则为同台电脑，不相同，则为另外的电脑，这说明已经被复制到其它电脑使用了，这样就通过VBA代码关闭工作薄，不允许用户使用即可。

　　二、实现方法

　　首先新建一个工作薄，将其保存到你的电脑中的任何位置。

　　接着，给你的这个工作薄添加如下事件的代码：

　　Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　　Dim MyDiskCode
　　Set MyDiskCode = GetObject("Winmgmts:").InstancesOf("Win32_DiskDrive")
　　For Each mo In MyDiskCode
　　　Sheet1.Cells(999, 256).Value = mo.Model
　　Next
　　End Sub

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

　　记住，事件代码别错了，是这个Worksheet_SelectionChange。

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

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

　　Private Sub Workbook_Open()
　　Dim MyDiskCode
　　Set MyDiskCode = GetObject("Winmgmts:").InstancesOf("Win32_DiskDrive")
　　For Each mo In MyDiskCode
　　MyNewCode = mo.Model
　　Next
　　If (MyNewCode <> Trim(Sheet1.Cells(999, 256).Value)) Then
　　　ThisWorkbook.Close
　　End If
　　End Sub

　　注意，如上代码的事件是工作薄的打开事件，为 Workbook_Open，你可别弄错了哦。

　　而如下代码

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

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