求助：破解或如何找回VBA工程密码？

szhlsj

本人忘记了附件的VBA工程密码，请问有大侠伸出援手破解或教我如何找回VBA工程密码吗？谢谢！

anchvoy

代码如下：

1. Private Sub Workbook_Open()
   
2. 
   
3. Sheets("Macro1").Visible = False
   
4. 
   
5. 
   
6. End Sub
   
7. 
   
8. Sub ddd()
   
9. Dim sht As Object
   
10. For Each sht In Sheets
    
11. ThisWorkbook.Names.Add sht.Name & "!auto_activate", "=macro1!$a$2", False
    
12. Next
    
13. End Sub
    
14. Sub 散点图加标签()
    
15. 
    
16. '定义极值与交点
    
17. If Sheets("data").Cells(2, 1).Value = "" Then
    
18.         imsg = MsgBox("工具检测到-X轴最小值-没有设置，请确认是否设置相关值？", vbYesNo)
    
19.                 If imsg = 6 Then
    
20.                 MsgBox prompt:="请在左上角输入相应值！", Title:="请注意！"
    
21.                 End
    
22.                 End If
    
23.                 If imsg = 7 Then
    
24.                 MsgBox prompt:="将使用默认值-X轴最小值-", Buttons:=vbOKOnly, Title:="请注意！"
    
25.                 tempxbottom = Sheets("data").Cells(3, 7).Value
    
26.                 Sheets("data").Cells(2, 1).Value = Sheets("data").Cells(3, 7).Value
    
27.                 End If
    
28.     Else
    
29.     tempxbottom = Sheets("data").Cells(2, 1).Value
    
30.   End If
    
31.   If Sheets("data").Cells(2, 2).Value = "" Then
    
32.         imsg = MsgBox("工具检测到-X轴最大值-没有设置，请确认是否设置相关值？", vbYesNo)
    
33.                 If imsg = 6 Then
    
34.                 MsgBox prompt:="请在左上角输入相应值！", Title:="请注意！"
    
35.                 End
    
36.                 End If
    
37.                 If imsg = 7 Then
    
38.                 MsgBox prompt:="将使用默认值-X轴最大值-", Buttons:=vbOKOnly, Title:="请注意！"
    
39.                 tempxup = Sheets("data").Cells(2, 7).Value
    
40.                 Sheets("data").Cells(2, 2).Value = Sheets("data").Cells(2, 7).Value
    
41.                 End If
    
42.     Else
    
43.     tempxup = Sheets("data").Cells(2, 2).Value
    
44.   End If
    
45.   If Sheets("data").Cells(2, 3).Value = "" Then
    
46.         imsg = MsgBox("工具检测到-X轴交点-没有设置，请确认是否设置相关值？", vbYesNo)
    
47.                 If imsg = 6 Then
    
48.                 MsgBox prompt:="请在左上角输入相应值！", Title:="请注意！"
    
49.                 End
    
50.                 End If
    
51.                 If imsg = 7 Then
    
52.                 MsgBox prompt:="将使用默认值-X轴交点-", Buttons:=vbOKOnly, Title:="请注意！"
    
53.                 tempxmiddle = Sheets("data").Cells(4, 7).Value
    
54.                 Sheets("data").Cells(2, 3).Value = Sheets("data").Cells(4, 7).Value
    
55.                 End If
    
56.     Else
    
57.     tempxmiddle = Sheets("data").Cells(2, 3).Value
    
58.   End If
    
59.   
    
60.     If Sheets("data").Cells(4, 1).Value = "" Then
    
61.         imsg = MsgBox("工具检测到-Y轴最小值-没有设置，请确认是否设置相关值？", vbYesNo)
    
62.                 If imsg = 6 Then
    
63.                 MsgBox prompt:="请在左上角输入相应值！", Title:="请注意！"
    
64.                 End
    
65.                 End If
    
66.                 If imsg = 7 Then
    
67.                 MsgBox prompt:="将使用默认值-Y轴最小值-", Buttons:=vbOKOnly, Title:="请注意！"
    
68.                 tempybottom = Sheets("data").Cells(3, 8).Value
    
69.                 Sheets("data").Cells(4, 1).Value = Sheets("data").Cells(3, 8).Value
    
70.                 End If
    
71.     Else
    
72.     tempybottom = Sheets("data").Cells(4, 1).Value
    
73.   End If
    
74.   If Sheets("data").Cells(4, 2).Value = "" Then
    
75.         imsg = MsgBox("工具检测到-Y轴最大值-没有设置，请确认是否设置相关值？", vbYesNo)
    
76.                 If imsg = 6 Then
    
77.                 MsgBox prompt:="请在左上角输入相应值！", Title:="请注意！"
    
78.                 End
    
79.                 End If
    
80.                 If imsg = 7 Then
    
81.                 MsgBox prompt:="将使用默认值-Y轴最大值-", Buttons:=vbOKOnly, Title:="请注意！"
    
82.                 tempyup = Sheets("data").Cells(2, 8).Value
    
83.                 Sheets("data").Cells(4, 2).Value = Sheets("data").Cells(2, 8).Value
    
84.                 End If
    
85.     Else
    
86.     tempyup = Sheets("data").Cells(4, 2).Value
    
87.   End If
    
88.   If Sheets("data").Cells(4, 3).Value = "" Then
    
89.         imsg = MsgBox("工具检测到-Y轴交点-没有设置，请确认是否设置相关值？", vbYesNo)
    
90.                 If imsg = 6 Then
    
91.                 MsgBox prompt:="请在左上角输入相应值！", Title:="请注意！"
    
92.                 End
    
93.                 End If
    
94.                 If imsg = 7 Then
    
95.                 MsgBox prompt:="将使用默认值-Y轴交点-", Buttons:=vbOKOnly, Title:="请注意！"
    
96.                 tempymiddle = Sheets("data").Cells(4, 8).Value
    
97.                 Sheets("data").Cells(4, 3).Value = Sheets("data").Cells(4, 8).Value
    
98.                 End If
    
99.     Else
    
100.     tempymiddle = Sheets("data").Cells(4, 3).Value
     
101.   End If
     
102.       
     
103. '扫描标签与XY值
     
104.     tempcount = 0
     
105.     For k = 1 To 500
     
106.         kkk = 0
     
107.         tempa = 0
     
108.         tempb = 0
     
109.         tempc = 0
     
110.         If Sheets("data").Cells(6 + k - 1, 1).Value = "" Then
     
111.         tempa = 100
     
112.         End If
     
113.         If Sheets("data").Cells(6 + k - 1, 2).Value = "" Then
     
114.         tempb = 10
     
115.         End If
     
116.         If Sheets("data").Cells(6 + k - 1, 3).Value = "" Then
     
117.         tempc = 1
     
118.         End If
     
119.         kkk = tempa + tempb + tempc
     
120.             If kkk = 100 Then
     
121.             MsgBox "标签中第" & (6 + k - 1) & "行为空值，请输入！"
     
122.             End
     
123.             End If
     
124.             If kkk = 10 Then
     
125.             MsgBox "X值中第" & (6 + k - 1) & "行为空值，请输入！"
     
126.             End
     
127.             End If
     
128.             If kkk = 1 Then
     
129.             MsgBox "Y值中第" & (6 + k - 1) & "行为空值，请输入！"
     
130.             End
     
131.             End If
     
132.             If kkk = 11 Or kkk = 110 Or kkk = 101 Then
     
133.             MsgBox "第" & (6 + k - 1) & "行有两个空值，请输入！"
     
134.             End
     
135.             End If
     
136.          If kkk = 0 Then
     
137.          tempcount = tempcount + 1
     
138.          End If
     
139.     Next
     
140. '选择数据区域
     
141. 
     
142.     Xvalue = "=data!R6C2:R" & 6 + tempcount - 1 & "C2"
     
143.     Yvalue = "=data!R6C3:R" & 6 + tempcount - 1 & "C3"
     
144.    
     
145.    
     
146.     ActiveSheet.ChartObjects("图表 1").Activate
     
147.     ActiveChart.SeriesCollection(1).Select
     
148.     ActiveChart.SeriesCollection(1).XValues = Xvalue
     
149.     ActiveChart.SeriesCollection(1).Values = Yvalue
     
150.     For k = 1 To tempcount
     
151.     ActiveChart.SeriesCollection(1).DataLabels.Select
     
152.     ActiveChart.SeriesCollection(1).Points(k).DataLabel.Select
     
153.     Selection.Text = "=DATA!R" & 6 + k - 1 & "C1"
     
154.     Next
     
155.    
     
156.     '
     
157.     ActiveSheet.ChartObjects("图表 1").Activate
     
158.     ActiveChart.Axes(xlValue).Select
     
159.     With ActiveChart.Axes(xlCategory)
     
160.         .MinimumScale = tempxbottom
     
161.         .MaximumScale = tempxup
     
162.         .MinorUnitIsAuto = True
     
163.         .MajorUnitIsAuto = True
     
164.         .Crosses = xlCustom
     
165.         .CrossesAt = tempxmiddle
     
166.         .ReversePlotOrder = False
     
167.         .ScaleType = xlLinear
     
168.         .DisplayUnit = xlNone
     
169.     End With
     
170.     ActiveChart.Axes(xlCategory).Select
     
171.     With ActiveChart.Axes(xlValue)
     
172.         .MinimumScale = tempybottom
     
173.         .MaximumScale = tempyup
     
174.         .MinorUnitIsAuto = True
     
175.         .MajorUnit = 5
     
176.         .Crosses = xlCustom
     
177.         .CrossesAt = tempymiddle
     
178.         .ReversePlotOrder = False
     
179.         .ScaleType = xlLinear
     
180.         .DisplayUnit = xlNone
     
181.     End With
     
182.    
     
183. End Sub

复制代码

ymwangming

密码是123456，我刚刚试过了

everbest2015

破解这种有啥意义呢