excel保护工作表密码pojie
打开你要破解的工作表，按 ALT + F11 启动VBA，将以下的代码复制上去，再按F5 键，就行了。
---------------------------------------------------------------
Public Sub AllInternalPasswords()
' Breaks worksheet and workbook structure passwords. Bob McCormick
' probably originator of base code algorithm modified for coverage
' of workbook structure / windows passwords and for multiple passwords
'
' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1)
' Modified 2003-Apr-04 by JEM: All msgs to constants, and
' eliminate one Exit Sub (Version 1.1.1)
' Reveals hashed passwords NOT original passwords
Const DBLSPACE As String = vbNewLine & vbNewLine
Const AUTHORS As String = DBLSPACE & vbNewLine & _
"Adapted from Bob McCormick base code by" & _
"Norman Harker and JE McGimpsey"
Const HEADER As String = "AllInternalPasswords User Message"
Const VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04"
Const REPBACK As String = DBLSPACE & "Please report failure " & _
"to the microsoft.public.excel.programming newsgroup."
Const ALLCLEAR As String = DBLSPACE & "The workbook should " & _
"now be free of all password protection, so make sure you:" & _
DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _
DBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _
DBLSPACE & "Also, remember that the password was " & _
"put there for a reason. Don't stuff up crucial formulas " & _
"or data." & DBLSPACE & "Access and use of some data " & _
"may be an offense. If in doubt, don't."
Const MSGNOPWORDS1 As String = "There were no passwords on " & _
"sheets, or workbook structure or windows." & AUTHORS & VERSION
Const MSGNOPWORDS2 As String = "There was no protection to " & _
"workbook structure or windows." & DBLSPACE & _
"Proceeding to unprotect sheets." & AUTHORS & VERSION
Const MSGTAKETIME As String = "After pressing OK button this " & _
"will take some time." & DBLSPACE & "Amount of time " & _
"depends on how many different passwords, the " & _
"passwords, and your computer's specification." & DBLSPACE & _
"Just be patient! Make me a coffee!" & AUTHORS & VERSION
Const MSGPWORDFOUND1 As String = "You had a Worksheet " & _
"Structure or Windows Password set." & DBLSPACE & _
"The password found was: " & DBLSPACE & "$$" & DBLSPACE & _
"Note it down for potential future use in other workbooks by " & _
"the same person who set this password." & DBLSPACE & _
"Now to check and clear other passwords." & AUTHORS & VERSION
Const MSGPWORDFOUND2 As String = "You had a Worksheet " & _
"password set." & DBLSPACE & "The password found was: " & _
DBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & _
"future use in other workbooks by same person who " & _
"set this password." & DBLSPACE & "Now to check and clear " & _
"other passwords." & AUTHORS & VERSION
Const MSGONLYONE As String = "Only structure / windows " & _
"protected with the password that was just found." & _
ALLCLEAR & AUTHORS & VERSION & REPBACK
Dim w1 As Worksheet, w2 As Worksheet
Dim i As Integer, j As Integer, k As Integer, l As Integer
Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer
Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer
Dim PWord1 As String
Dim ShTag As Boolean, WinTag As Boolean
Application.ScreenUpdating = False
With ActiveWorkbook
WinTag = .ProtectStructure Or .ProtectWindows
End With
ShTag = False
For Each w1 In Worksheets
ShTag = ShTag Or w1.ProtectContents
Next w1
If Not ShTag And Not WinTag Then
MsgBox MSGNOPWORDS1, vbInformation, HEADER
Exit Sub
End If
MsgBox MSGTAKETIME, vbInformation, HEADER
If Not WinTag Then
MsgBox MSGNOPWORDS2, vbInformation, HEADER
Else
On Error Resume Next
Do 'dummy do loop
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
With ActiveWorkbook
.Unprotect Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
If .ProtectStructure = False And _
.ProtectWindows = False Then
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
MsgBox Application.Substitute(MSGPWORDFOUND1, _
"$$", PWord1), vbInformation, HEADER
Exit Do 'Bypass all for...nexts
End If
End With
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
Loop Until True
On Error GoTo 0
End If
If WinTag And Not ShTag Then
MsgBox MSGONLYONE, vbInformation, HEADER
Exit Sub
End If
On Error Resume Next
For Each w1 In Worksheets
'Attempt clearance with PWord1
w1.Unprotect PWord1
Next w1
On Error GoTo 0
ShTag = False
For Each w1 In Worksheets
'Checks for all clear ShTag triggered to 1 if not.
ShTag = ShTag Or w1.ProtectContents
Next w1
If ShTag Then
For Each w1 In Worksheets
With w1
If .ProtectContents Then
On Error Resume Next
Do 'Dummy do loop
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
.Unprotect Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
If Not .ProtectContents Then
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
MsgBox Application.Substitute(MSGPWORDFOUND2, _
"$$", PWord1), vbInformation, HEADER
'leverage finding Pword by trying on other sheets
For Each w2 In Worksheets
w2.Unprotect PWord1
Next w2
Exit Do 'Bypass all for...nexts
End If
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
Loop Until True
On Error GoTo 0
End If
End With
Next w1
End If
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER
End Sub
EXCEL vba工程密码破解
这种方法实际是避开VBA工程密码验证，即，骗vba编辑器，该密码输入成功，请求放行。
原理不多说了，先将方法公布：
===================================================
1.新建一个工作簿，打开，按ALT+F11，进入vba代码编辑器窗口：
2.新建一个模块，“插入”--“模块”把以下代码复制进模块并保存
---------------------------------------------------------------------------------------
Option Explicit
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Long, Source As Long, ByVal Length As Long)
Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Long, _
ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, _
ByVal lpProcName As String) As Long
Private Declare Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As Long, _
ByVal pTemplateName As Long, ByVal hWndParent As Long, _
ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer
Dim HookBytes(0 To 5) As Byte
Dim OriginBytes(0 To 5) As Byte
Dim pFunc As Long
Dim Flag As Boolean
Private Function GetPtr(ByVal Value As Long) As Long
'获得函数的地址
GetPtr = Value
End Function
Public Sub RecoverBytes()
'若已经hook,则恢复原API开头的6字节,也就是恢复原来函数的功能
If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 6
End Sub
Public Function Hook() As Boolean
Dim TmpBytes(0 To 5) As Byte
Dim p As Long
Dim OriginProtect As Long
Hook = False
'VBE6.dll调用DialogBoxParamA显示VB6INTL.dll资源中的第4070号对话框(就是输入密码的窗口)
'若DialogBoxParamA返回值非0,则VBE会认为密码正确,所以我们要hook DialogBoxParamA函数
pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")
'标准api hook过程之一: 修改内存属性,使其可写
If VirtualProtect(ByVal pFunc, 6, &H40, OriginProtect) <> 0 Then
'标准api hook过程之二: 判断是否已经hook,看看API的第一个字节是否为&H68,
'若是则说明已经Hook
MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6
If TmpBytes(0) <> &H68 Then
'标准api hook过程之三: 保存原函数开头字节,这里是6个字节,以备后面恢复
MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6
'用AddressOf获取MyDialogBoxParam的地址
'因为语法不允许写成p = AddressOf MyDialogBoxParam,这里我们写一个函数
'GetPtr,作用仅仅是返回AddressOf MyDialogBoxParam的值,从而实现将
'MyDialogBoxParam的地址付给p的目的
p = GetPtr(AddressOf MyDialogBoxParam)
'标准api hook过程之四: 组装API入口的新代码
'HookBytes 组成如下汇编
'push MyDialogBoxParam的地址
'ret
'作用是跳转到MyDialogBoxParam函数
HookBytes(0) = &H68
MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4
HookBytes(5) = &HC3
'标准api hook过程之五: 用HookBytes的内容改写API前6个字节
MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 6
'设置hook成功标志
Flag = True
Hook = True
End If
End If
End Function
Private Function MyDialogBoxParam(ByVal hInstance As Long, _
ByVal pTemplateName As Long, ByVal hWndParent As Long, _
ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer
If pTemplateName = 4070 Then
'有程序调用DialogBoxParamA装入4070号对话框,这里我们直接返回1,让
'VBE以为密码正确了
MyDialogBoxParam = 1
Else
'有程序调用DialogBoxParamA,但装入的不是4070号对话框,这里我们调用
'RecoverBytes函数恢复原来函数的功能,在进行原来的函数
RecoverBytes
MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
hWndParent, lpDialogFunc, dwInitParam)
'原来的函数执行完毕,再次hook
Hook
End If
End Function
-------------------------------------------------------------------
3.右击sheet1工作表，“查看代码”复制以下代码进去并保存：
-------------------------------------------------------------------
sub 破解()
if hook then
msgbox "破解成功"
end if
end sub
sub 恢复()
RecoverBytes
msgbox "恢复成功"
end sub
------------------------------------
4.到此,一个vba破解程序完成了,回到该工作簿窗口,文件-打开 打开需要破解vba工程密码的工作簿.
5.运行"call 破解" 稍后你再双击刚才要解密的VBA工程窗体.是不是如入无人之境啊,工程保护密码形同虚设啊?
6.破解完成后,请右键刚破解的VBA工程,在"查看工程时需要密码"的地方复选框取消选择,OK.完成.
7.完成后别忘了执行"call 恢复",恢复密码保护(恢复程序的密码保护,已被破解的文件不收影响. (请勿用于非法途径)
已验证，破解成功
密码破解软件合集(Passware Kit Enterprise) 10.3 Build 2585汉化绿色免费版
http://www.3987.com/xiazai/2/70/1329.html
excel 2003 版 ：插入 → 名称 → 定义 或者 按 CTRL+F3 来找到名称管理器
excel 2007或者2010 在 公式 → 名称管理器
还应用到了条件格式和嵌套if公式
Download Excel
2.改变 excel 2003 在任务栏中显示一个excel图标还是多个图标
答：工具/选项/视图/任务栏中的窗口前打上勾，确定。
3.sheet标签不见了
答：2003版，工具－选项－视图，勾上“工作表标签”。
2007版，Office按钮－Excel选项－高级，勾上“此工作簿的显示选项”下的“显示工作表标签”。
4.自定义序列，可自己排一个序列使用来排序
excel 2003 在工具 - 选项里
excel 2007 在OFFICE图标——EXCEL选项（与退出并排）——常用——（使用EXCEL时采用的首选项）——（创建用于排序和填充序列的列表）编辑自定义列表
——自定义——添加（你自己的序列）——（保存）确定——OK
5.
