VBA入门到进阶常用知识代码总结64

第64集 Excel命令栏设置(二)
309、 在指定的命令栏中添加命令
单元格右键菜单添加一个名为“我的命令”的命令
Dim mycom As CommandBarComboBox
Sub tiancom()
On Error Resume Next
Dim myBAR As CommandBarButton
Application.CommandBars(“CELL”).Controls(“我的命令”).Delete
Set myBAR = Application.CommandBars(“cell”).Controls.Add(before:=1) '添加到最上的位置
With myBAR
.Caption = “我的命令”
.BeginGroup = True '添加分组线
.FaceId = 199 '显示的图标
.Style = msoButtonIconAndCaption '图标和文字的显示
.OnAction = “ABC” '指定要运行的宏
End With
End Sub

Sub ABC()
MsgBox “这是运行的宏”
End Sub
310、 添加组合框（Excel 2010运行无效果）
Sub 添加组合框()
On Error Resume Next
Dim x
Application.CommandBars(“CELL”).Controls(“工作表显示”).Delete
Set mycom = Application.CommandBars(“cell”).Controls.Add(Type:=msoControlComboBox, before:=1) '添加到最上的位置
With mycom
.Caption = “工作表显示”
.BeginGroup = True '添加分组线
'.FaceId = 199 '显示的图标
'.Style = msoButtonIconAndCaption '图标和文字的显示
.OnAction = “选取工作表” '指定要运行的宏
.Width = 100
.DropDownWidth = 70
For x = 1 To Sheets.Count
.AddItem Sheets(x).Name
Next x
End With
End Sub
311、 添加子菜单

Sub 添加子菜单()
On Error Resume Next
Dim x, copup As CommandBarPopup, copup1 As CommandBarButton, copup2 As CommandBarPopup
Application.CommandBars(“CELL”).Controls(“工作表显示”).Delete
Set copup = Application.CommandBars(“cell”).Controls.Add(Type:=msoControlPopup, before:=1) '添加到最上的位置
With copup
.Caption = “工作表显示”
.BeginGroup = True '添加分组线
End With
Set copup1 = copup.Controls.Add(before:=1) '添加到最上的位置
With copup1
.Caption = “复制工作表”
.FaceId = 22
.Style = msoButtonIconAndCaption '图标和文字的显示
End With
Set copup1 = copup.Controls.Add(before:=2) '添加到最上的位置
With copup1
.Caption = “删除工作表”
.FaceId = 20
.Style = msoButtonIconAndCaption '图标和文字的显示
End With
Set copup2 = copup.Controls.Add(Type:=msoControlPopup, before:=3) '添加到最上的位置
With copup2
.Caption = “移动工作表”
End With
End Sub
312、 用copyFace方法复制命令按钮的图标
Sub FaceId()
Application.ScreenUpdating = False
Dim x As Integer, Y As Integer, k As Integer
On Error Resume Next
Dim 控件 As CommandBarButton
Set 控件 = Application.CommandBars(4).Controls.Add
For x = 1 To 30
For Y = 1 To 10
k = k + 1
Sheets(“图标”).Cells(x, Y) = k
控件.FaceId = k
控件.CopyFace
Sheets(“图标”).Cells(x, Y).Select
ActiveSheet.Paste
Next Y
Next x
控件.Delete
Set 控件 = Nothing
Application.ScreenUpdating = True
End Sub
313、 添加自定义图片命令
Sub 添加() '添加自定义图片命令
删除图片
插入图片
Dim Mcom As CommandBar
Dim Mbotton As CommandBarButton
Dim i As Integer
On Error Resume Next
Application.CommandBars(“工具栏”).Delete
Set Mcom = Application.CommandBars.Add
Mcom.Visible = True
Mcom.Name = “工具栏”
For i = 1 To 4
Set Mbotton = Mcom.Controls.Add
Sheets(“Sheet1”).Pictures(i).Copy
Mbotton.PasteFace
Next i
删除图片
End Sub
Sub 插入图片()
Dim x, bbb
For x = 1 To 4
Sheets(“SHEET1”).Pictures.Insert ThisWorkbook.Path & “” & x & “.jpg”
Next x
End Sub
Sub 删除图片()
On Error Resume Next
Dim xx
For Each xx In Sheets(“Sheet1”).Pictures
xx.Delete
Next xx
End Sub