返回目录：excel表格制作
Sub CreateToolBar()
Dim newTool As CommandBar
Dim i As Integer '如果百发现有相同工具栏，删度除该工具栏
On Error Resume Next
CommandBars("Custom Toolbar").Delete
On Error GoTo 0 '添加名称为“Custom Toolbar”的知工具栏，并在工作表上方显示
Set newTool = CommandBars.Add(Name:="Custom Toolbar", Position:=msoBarTop)
With newTool
.Visible = True
With .Controls.Add(Type:=msoControlButton)
.Caption = "带标题复道制"
.Style = msoButtonIconAndCaption
.TooltipText = "带标题复制"
.FaceId = 18
.OnAction = "copyPro"
End With
End With
End Sub
试试这个，内按钮名字和函数名自己容改下
不是你的代码有问题，如果windows系统是HOME版的则会经常出问题，如果是Professional版的就好了，我已做过多次测试，你试试。
在CommandBars(1)上添加，然后就跑会到加载项选项卡上。以下是我的一些实例
1）在sheet1的A:G列我放了一些按钮的e79fa5e98193e4b893e5b19e336基础信息，以便调用
2）添加按钮的过程如下
Sub egAddButtons()
On Error Resume Next
Dim I As Integer, bar As CommandBar, sht As Worksheet
Set sht = ThisWorkbook.Sheets(1)
Set bar = Application.CommandBars(1)
For I = 1 To 17
With bar.Controls.Add(msoControlButton, , , , True)
.OnAction = sht.Range("A1").Offset(I, 3).Value
.Style = msoButtonIconAndCaption
.FaceId = sht.Range("A1").Offset(I, 4).Value
.Caption = sht.Range("A1").Offset(I, 1).Value
.Tag = "NewButton"
End With
Next
Set sht = Nothing
Set bar = Nothing
End Sub
3）删除按钮的过程
Sub egDeleteButtons()
On Error Resume Next
Dim bar As CommandBar, ctl As CommandBarControl
Set bar = Application.CommandBars(1)
With bar
For Each ctl In bar.Controls
If ctl.Tag = "NewButton" Then
ctl.Visible = False
ctl.Delete
End If
Next
End With
Set bar = Nothing
Set ctl = Nothing
End Sub
Application.CommandBars(1).Controls(CtrButton).Caption = "常用工具（彭希仁）" 这个语句有错误！百
不会报错的原因是度：On Error Resume Next 语句将错误忽略掉啦，将此语句去除或注释，然后单步执专行，就可看到哪出错啦！如下图：（建议调试程序时属尽量不要使用此语句）