VB6.0封裝Excel2007功能區菜單 ----Ribbon CustomUI 放在資源文件


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>


免責聲明!

本站轉載的文章為個人學習借鑒使用,本站對版權不負任何法律責任。如果侵犯了您的隱私權益,請聯系本站郵箱yoyou2525@163.com刪除。



 
粵ICP備18138465號   © 2018-2025 CODEPRJ.COM