1.下載安裝VB6.0企業中文版(請自行百度搜索下載安裝)
2.啟動VB6.0,選擇《外接程序》
3.【工程】---【引用】---Microsoft Excel 14.0 Objects Library和Microsoft Office 14.0 Objects Library(勾選)
4.設置Connect屬性
5.清除原connect由系統產生的原碼
輸入如下內容:
Implements IDTExtensibility2
Implements IRibbonExtensibility
Public xlapp As Excel.Application
Private Function IRibbonExtensibility_GetCustomUI(ByVal RibbonID As String) As String
IRibbonExtensibility_GetCustomUI = LoadResString(101)
'用於從資源文件中載入自定義功能區的xml代碼
End Function
Private Sub IDTExtensibility2_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant)
Set xlapp = Application '將xlapp賦值為Excel程序
End Sub
Private Sub IDTExtensibility2_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
End Sub
Private Sub IDTExtensibility2_OnAddInsUpdate(custom() As Variant)
End Sub
Private Sub IDTExtensibility2_OnBeginShutdown(custom() As Variant)
End Sub
Private Sub IDTExtensibility2_OnStartupComplete(custom() As Variant)
End Sub
Private Sub IDTExtensibility_OnStartupComplete(custom() As Variant)
End Sub
Public Sub 完美(ByVal control As IRibbonControl)
Test1
End Sub
Public Sub 視頻(ByVal control As IRibbonControl)
Test2
End Sub
Public Sub EH(ByVal control As IRibbonControl)
Test3
End Sub
Public Sub 解密(ByVal control As IRibbonControl)
Test4
End Sub
Public Sub 工作表加密(ByVal control As IRibbonControl)
Test5
End Sub
Sub Test1()
'完美
xlapp.ActiveWorkbook.FollowHyperlink _
Address:="http://www.excelbbs.com/forum.php", _
NewWindow:=True
End Sub
Sub Test2()
'視頻
xlapp.ActiveWorkbook.FollowHyperlink _
Address:="http://www.56.com/h48/uv.index.php?user=caomingwumr", _
NewWindow:=True
End Sub
Sub Test3()
'EH
xlapp.ActiveWorkbook.FollowHyperlink _
Address:="http://club.excelhome.net/", _
NewWindow:=True
End Sub
Sub Test4()
'解密 備注這個代碼是采集EH論壇一個前輩的的
With xlapp
.ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True, AllowUsingPivotTables:=True
.ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFiltering:=True, AllowUsingPivotTables:=True
.ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:= _
False, AllowFiltering:=True, AllowUsingPivotTables:=True
.ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFiltering:=True, AllowUsingPivotTables:=True
.ActiveSheet.UnProtect
ANS = MsgBox("密碼已破解", 48, "佛山小老鼠制作")
End With
End Sub
Sub Test5()
'工作表加密()
Dim I As Integer
For I = 1 To xlapp.Sheets.Count
xlapp.Sheets(I).Protect Password:="197698"
Next I
End Sub
6.【外接程序】---【外接程序管理器】--選取【VB 6 資源編輯器】---設置加載行為(具體見圖)
7.【工具】--【資源編輯器】
8.點擊【abc】圖標(編輯字符串表格)--然后再【101】右邊框中從(CustomUI.xml復制的代碼)粘貼上去
9.【文件】---生成【xxx.dll】 如果有提示要保存,點確定即可。
'===========================================================
CustomUI 文件內容:
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
<ribbon startFromScratch="false">
<tabs>
<tab id="rxtabCustom"
label="佛山小老鼠工具"
insertBeforeMso="TabHome">
<group id="mygroupB" label="加解密">
<button id="a1"
imageMso="DatabasePermissions"
size="large"
label="工作表加密"
onAction="工作表加密"/>
<button id="a2"
imageMso="AdpDiagramKeys"
size="large"
label="工作表解密"
onAction="解密"/>
</group>
<group id="mygroupD" label="VBA開發">
<control idMso="VisualBasic" label="VBE編輯器" />
<control idMso="MacroRecord" label="錄制新宏" />
<control idMso="ControlsGallery" label="窗體與控件" />
</group>
<group id="mygroupE" label="關於 佛山小老鼠">
<button id="E1"
imageMso="DataSourceCatalogServerScript"
size="large"
label="ExcelHome論壇"
onAction="EH"/>
<button id="E2"
imageMso="AccountMenu"
size="large"
label="完美論壇"
onAction="完美"/>
<button id="E3"
imageMso="FilePackageForCD"
size="large"
label="VBA入門視頻"
onAction="視頻"/>
</group>
</tab>
</tabs>
</ribbon>
</customUI>