主要来自网络，把两种方法结合到一起，效果确实不错。

'1、将Excle文件的文件扩展名为RAR。

'2、在xl里找到vbaProject.bin并解压。

'3、新建一个EXCEL文件，将下列代码添加为宏，并运行MoveProtect()宏，打开前一步解压的文件。

'4、解密成功后，将该.bin文件再压缩回第一步得到的压缩文件。

'5、将该文件扩展名改回原扩展名（如：xlam,xlsm等）

'注：下列代码来自网络，只做了一处修改，添加了bin文件使它适用面加宽。

'移除VBA编码保护

Sub MoveProtect()

    Dim FileName As String

    FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla & *.bin）,*.xls;*.xla;*.bin", , "VBA破解")

    If FileName = CStr(False) Then

       Exit Sub

    Else

       VBAPassword FileName, False

    End If

End Sub

'设置VBA编码保护

Sub SetProtect()

    Dim FileName As String

    FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla）,*.xls;*.xla", , "VBA破解")

    If FileName = CStr(False) Then

       Exit Sub

    Else

       VBAPassword FileName, True

    End If

End Sub

Private Function VBAPassword(FileName As String, Optional Protect As Boolean = False)

      If Dir(FileName) = "" Then

         Exit Function

      Else

         FileCopy FileName, FileName & ".bak"

      End If

      Dim GetData As String * 5

      Open FileName For Binary As #1

      Dim CMGs As Long

      Dim DPBo As Long

      For i = 1 To LOF(1)

          Get #1, i, GetData

          If GetData = "CMG=""" Then CMGs = i

          If GetData = "[Host" Then DPBo = i - 2: Exit For

      Next

      If CMGs = 0 Then

         MsgBox "请先对VBA编码设置一个保护密码...", 32, "提示"

         Exit Function

      End If

      If Protect = False Then

         Dim St As String * 2

         Dim s20 As String * 1

         '取得一个0D0A十六进制字串

         Get #1, CMGs - 2, St

         '取得一个20十六制字串

         Get #1, DPBo + 16, s20

         '替换加密部份机码

         For i = CMGs To DPBo Step 2

             Put #1, i, St

         Next

         '加入不配对符号

         If (DPBo - CMGs) Mod 2 <> 0 Then

            Put #1, DPBo + 1, s20

         End If

         MsgBox "文件解密成功......", 32, "提示"

      Else

         Dim MMs As String * 5

         MMs = "DPB="""

         Put #1, CMGs, MMs

         MsgBox "对文件特殊加密成功......", 32, "提示"

      End If

      Close #1

End Function