做个记号

Private Sub Workbook_BeforeClose(Cancel As Boolean)
("我的工具栏").Delete
End Sub

Private Sub Workbook_Open()
ActiveSheet.Shapes("Picture 1").Copy
(Name:="我的工具栏").Visible = True
("我的工具栏").Controls.Add Type:=msoControlButton, ID:=2950, Before:=1
("我的工具栏").Controls(1).OnAction = "jj"
("我的工具栏").Controls(1).PasteFace
("我的工具栏").Position = msoBarTop

End Sub

Sub 自定义工具栏()

    Dim i%, r%, j%   '循环变量,最大行'
    Dim icoPath As String    '图标路径'
    Dim btn As CommandBarButton    '按钮
    Dim bt As String, gjl$    '标题,工具栏'
    Dim arr, brr, crr, drr
    icoPath = ThisWorkbook.path & "\tool\tb\"    '图片路径=这个工作薄路径+\tool\ico\'

    arr = ThisWorkbook.Sheets("清单").UsedRange
    '--------------------------------------------------
    Dim Toolbar As CommandBar, myVal$   '工具栏'临时变量
    Dim d As Object
    Set d = CreateObject("scripting.dictionary")    '创建字典对象
    Set regex1 = CreateObject("VBSCRIPT.REGEXP")    'RegEx为建立正则表达式
    With regex1
        .Global = True    '设置全局可用
        .Pattern = ".+"
    End With
    '--------------------------------------------------
    On Error Resume Next
    Application.ScreenUpdating = False
    ("MySoSo").Delete    '删除mysoso工具栏'
    Set Toolbar = ("MySoSo", msoBarTop)    '创建一个名为mysoso的工具栏,位置放在最上面'

    '--------------------------------------------------
    With Toolbar
        .Protection = msoBarNoResize    '防止用户访问“添加或删除按钮”菜单
        .Visible = True    '显示工具栏'
        .Position = msoBarTop    '设置命令栏的位置为顶部'
        '--------------------------------------------------
        With .Controls.Add(Type:=msoControlButton)    '新建一个按钮'
            .Caption = "★自己定制★"    '按钮名称'
            .OnAction = "自定义菜单"    '按钮执行的命令'
            .FaceId = 609    '3198    '按钮图标'
            .BeginGroup = True    '显示分割线'
            .Style = msoButtonIconAndCaptionBelow    '样式等于图片+文本,文本在下面图标在上面'
            .TooltipText = "把自己常用的工具通过自定义放到工具栏中"    '鼠标停放时显示的文本'
        End With
        '--------------------------------------------------
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "常用文件"    '按钮名称'
            .OnAction = "常用的文件"    '按钮执行的命令'
            .FaceId = 2105    '按钮图标'
            .BeginGroup = True    '显示分割线'
            .Style = msoButtonIconAndCaptionBelow    '样式等于图片+文本,文本在下面图标在上面'
        End With
        '--------------------------------------------------
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "常用路径"    '按钮名称'
            .OnAction = "常用的路径"    '按钮执行的命令'
            .FaceId = 1660    '按钮图标'
            '.BeginGroup = True    '显示分割线'
            .Style = msoButtonIconAndCaptionBelow    '样式等于图片+文本,文本在下面图标在上面'
        End With
        '--------------------------------------------------
        If GetSetting("PUPNAME", "APPNAME", "自定义工具栏") <> "" Then    '如果注册表中有自定义工具栏项'
            gjl = GetSetting("PUPNAME", "APPNAME", "自定义工具栏")    '获取注册表中自定义工具栏的值'
            Set c = regex1.Execute(gjl)
            For j = 0 To c.Count - 1
                d(c.Item(j).Value) = 0
            Next j
            '--------------------------------------------------
        Else
            brr = Array("科室定制", "智能文本", "智能加边框", "自动筛选", "相同值标色", "删除重复行", "数据查询", "颜色筛选")
            For j = 0 To UBound(brr)
                d(brr(j)) = 0
            Next j
            SaveSetting "PUPNAME", "APPNAME", "自定义工具栏", Join(brr, vbLf)
        End If
        '--------------------------------------------------
        N = UBound(arr)    '获取功能表格最大行'
        For j = 2 To N
            If d.exists(arr(j, 3)) Then   '如果单元格中的值能在gjl中找到
                bt = arr(j, 3)
                '--------------------------------------------------
                Set btn = .Controls.Add(msoControlButton, , , , True)    '在mysoso工具栏上创建一个按钮'
                With btn
                    .Caption = bt    '按钮名称'
                    .OnAction = bt    '按钮执行的命令'
                    .TooltipText = "【" & bt & "】" & arr(j, 4)  '鼠标停放时显示的文本'
                    .BeginGroup = True    '显示分割线'
                    .Style = msoButtonIconAndCaptionBelow    '样式等于图片+文本,文本在下面图标在上面'
                    .Picture = LoadPicture(icoPath & bt & ".jpg")    '获取路径下的图片作为图标'
                End With
                '--------------------------------------------------
            End If
        Next j
        '--------------------------------------------------
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "SoSo工具"    '按钮名称'
            .OnAction = "显示界面"    '按钮执行的命令'
            .FaceId = 266    '按钮图标'
            .BeginGroup = True    '显示分割线'
            .Style = msoButtonIconAndCaptionBelow    '样式等于图片+文本,文本在下面图标在上面'
        End With
        '--------------------------------------------------
    End With
    Application.ScreenUpdating = True
    Set Toolbar = Nothing
End Sub

Sub 右键菜单()
    With ("Cell")
        .Reset
        '--------------------------------------------------
        With .Controls.Add(Type:=msoControlButton, before:=1)
            .Caption = "SoSo工具(&V)"
            .FaceId = 266
            .OnAction = "显示界面"
        End With
        '--------------------------------------------------
        With .Controls.Add(Type:=msoControlButton, before:=2)
            .Caption = "智能加边框(&Z)"
            .OnAction = "智能加边框"
            .TooltipText = "无需选定单元格即把所用处加上边框"
            .FaceId = 800
        End With
        '--------------------------------------------------
        With .Controls.Add(Type:=msoControlButton, before:=3)
            .Caption = "自动筛选(&Q)"
            .OnAction = "自动筛选"
            .TooltipText = "在当前列筛选当前单元格"
            .FaceId = 458
        End With
        '--------------------------------------------------
        With .Controls.Add(Type:=msoControlButton, before:=4)
            .Caption = "多条件筛选"
            .OnAction = "多条件筛选"
            .TooltipText = "在当前列筛选当前单元格"
            .FaceId = 628
            '  .BeginGroup = True    '添加分组线
        End With
        '--------------------------------------------------
        With .Controls.Add(Type:=msoControlButton, before:=5)
            .Caption = "多表格计算"
            .OnAction = "多表格计算"
            .TooltipText = "多个表格的相同单元格进行计算"
            .FaceId = 1548
            .BeginGroup = True    '添加分组线
        End With

        '--------------------------------------------------
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "筛选单元格颜色(ctrl+Q取消筛选)"
            .BeginGroup = True    '添加分组线
            .OnAction = "筛选单元格颜色"
            .TooltipText = "在当前列筛选和当前单元格相同颜色的单元格,再次点击取消筛选"
            .FaceId = 3077
        End With
        '--------------------------------------------------
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "筛选字体颜色(ctrl+Q取消筛选)"

            .OnAction = "筛选字体颜色"
            .TooltipText = "在当前列筛选和当前单元格相同字体颜色的单元格,再次点击取消筛选"
            .FaceId = 2611
        End With
        '--------------------------------------------------
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "按指定内容筛选"
            .OnAction = "按指定内容筛选"
            .TooltipText = "在当前列筛选和包含指定内容的的单元格。"
            .FaceId = 499
        End With
        '--------------------------------------------------
        With .Controls.Add(Type:=msoControlPopup)
            .Caption = "选择格式相似的单元格"
            .BeginGroup = True    '添加分组线
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "填充颜色相同"
                ' .BeginGroup = True    '添加分组线
                .OnAction = "选取填充颜色相同"
                .FaceId = 3077
            End With
            '--------------------------------------------------
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "字体颜色相同"
                ' .BeginGroup = True    '添加分组线
                .OnAction = "选取字体颜色相同"
                .FaceId = 2611
            End With
            '--------------------------------------------------
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "单元格数字格式相同"
                '  .BeginGroup = True    '添加分组线
                .OnAction = "选取单元格数字格式相同"
                .FaceId = 2773
            End With
            '--------------------------------------------------
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "单元格内容相同"
                '  .BeginGroup = True    '添加分组线
                .OnAction = "选择内容相同的单元格"
                .FaceId = 720
            End With
            '--------------------------------------------------
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "更多选择..."
                .BeginGroup = True    '添加分组线
                .OnAction = "按条件选取单元格"
                .FaceId = 2761
            End With
        End With
        '--------------------------------------------------
        With .Controls.Add(Type:=msoControlPopup)
            .Caption = "美化表格(&G)"
            ' .OnAction = "边框样式"
            .BeginGroup = True    '添加分组线
            .TooltipText = "当前选区设置一种边框样式"
            '--------------------------------------------------
            With .Controls.Add(msoControlButton)
                .Caption = "美化表格"
                .OnAction = "美化表格"
                .FaceId = 635
            End With
            '--------------------------------------------------
            With .Controls.Add(msoControlButton)
                .Caption = "隔行标色"
                .OnAction = "隔行标色"
                .FaceId = 692
            End With
            '--------------------------------------------------
            With .Controls.Add(msoControlButton)
                .Caption = "单元格3D效果"
                .OnAction = "单元格3D效果"
                .FaceId = 282
            End With
            '--------------------------------------------------
            With .Controls.Add(msoControlButton)
                .Caption = "隐藏网格线"
                .OnAction = "隐藏网格线"
                .FaceId = 485
            End With
            '--------------------------------------------------
            With .Controls.Add(msoControlButton)
                .Caption = "工作表其他设置"
                .OnAction = "工作表快捷设置"
                .FaceId = 362
            End With
            '--------------------------------------------------
            With .Controls.Add(msoControlButton)
                .Caption = "录入当前日期用时间（Ctrl+Shift+Z）"
                .OnAction = "录入当前日期用时间"
                .BeginGroup = True    '添加分组线
                .FaceId = 265
            End With
            With .Controls.Add(msoControlButton)
                .Caption = "时间格式设置"
                .OnAction = "时间格式设置"
                .FaceId = 209
            End With
            '--------------------------------------------------
        End With


    End With
End Sub

Dim oWD As Object
Implements IRibbonExtensibility '添加对 IRibbonExtensibility 接口的引用

'启动
Private Sub AddinInstance_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant)
Set oWD = Application
MsgBox "我的com加载项已经成功加载！"
End Sub

'实现IRibbonExtensibility接口的唯一成员 GetCustomUI，此过程调用 GetRibbonXML 方法，正如其名称所示，
'该方法将自定义 XML 返回到 GetCustomUI 方法，后者然后将自定义 XML 添加到功能区用户界面以便在加载外接程序时实现它。
Public Function IRibbonExtensibility_GetCustomUI(ByVal RibbonID As String) As String
      IRibbonExtensibility_GetCustomUI = GetRibbonXML()
End Function

'添加 XML 自定义标记代码
Public Function GetRibbonXML() As String
   Dim sRibbonXML As String

    sRibbonXML = "<customUI xmlns=""http://schemas. >" & _
                "<ribbon>" & _
                "<tabs>" & _
                "<tab id=""CustomTab"" label=""sanjie"">" & _
                "<group id=""SampleGroup"" label=""Sample Group"">" & _
                "<button id=""Button"" label=""Insert Name"" size=""large"" imageMso=""HappyFace"" onAction=""InsertCompanyName"" />" & _
                "</group >" & _
                "</tab>" & _
                "</tabs>" & _
                "</ribbon>" & _
                "</customUI>"
   
   GetRibbonXML = sRibbonXML
   
   End Function

'控件回调的过程
Public Sub InsertCompanyName(ByVal control As IRibbonControl)
   ' Inserts the specified text at the beginning of a range.
   Dim MyText As String
   Dim MyRange As Object
   Set MyRange = oWD.ActiveDocument.Range
   MyText = "http://www.
   ' Inserts text at the beginning
   ' of the active document.
   MyRange.InsertBefore (MyText)
End Sub

Private JXMBAR As Object
Private WithEvents Caishan As

Private Sub Class_Initialize()
    Dim WJT As Object
   
    On Error Resume Next
    Set WJT = GetObject(, "Excel.Application")

    Dim JXMBAR As
    If WJT Is Nothing Then
      MsgBox "获取Application对象出错！"
    Else
      For Each JXMBAR In
        If JXMBAR.Name = "望江婷的工具" Then ("望江婷的工具").Delete
      Next
      
      (Name:="望江婷的工具").Visible = True
      ("望江婷的工具").Position = msoBarTop
   
      Set Caishan = ("望江婷的工具").Controls.Add(Type:=msoControlButton)
      With Caishan
        .BeginGroup = True   '分隔线
        .Caption = "删除数据(&D)"
        .FaceId = 9404
        .Style = msoButtonIconAndCaptionBelow
        .ToolTipText = "删除当前工作表的数据"
     End With
    End If
End Sub

Private Sub Class_Terminate()
  On Error Resume Next
  JXMBAR.Delete
End Sub

Private Sub Caishan_Click(ByVal Ctrl As , CancelDefault As Boolean)
  Dim xlapp As Object, xlbok As Object, xlsht1 As Object

  On Error Resume Next
  
  Set xlapp = GetObject(, "Excel.Application")  '取得Excel实例[/color]
  Set xlbok = xlapp.ActiveWorkbook              '取得Excel实例下活动工作簿[/color]
  If MsgBox("确实要清除现有的数据，重新使用吗？", vbInformation + vbYesNo, "警告") = vbYes Then xlbok.Sheets("收支").Range("A3：E65536").Formula = ""
End Sub

不错！！！

做个记号！！！

不错，学习了

不错，学习了