在VBA中,我创建了一个带有按钮的自定义commmandbar,允许我在MS Project规划中设置选择行的背景颜色。
我想在每个按钮上显示16x16位图图标,而不是使用文字字幕。我可以从硬盘加载这些位图,但是想在VBA中创建它们。
这可能吗?在我的广泛研究之后,VBA中没有位图或绘图类。
现在是什么:
应该成为什么(手动完成):
代码:
'1 red
'2 yellow
'3 green
'4 blue
'5 dark blue
'6 fushia
'7 white
Sub createcolorbar()
Dim cbar As CommandBar
Dim cctrl As CommandBarButton
On Error Resume Next
CommandBars("Colors").Delete
Set cbar = CommandBars.Add("Colors")
cbar.Visible = True
cbar.Position = msoBarTop
With cbar
'white
Set ctrl = .Controls.Add(msoControlButton, , , , True)
With ctrl
.BeginGroup = True
.Caption = "White"
.State = msoButtonUp
.Style = msoButtonIconAndCaption 'change for icon
.OnAction = "Macro ""color_white"""
'.FaceId = 59 'Smiley
.Picture = stdole.StdFunctions.LoadPicture("c:\Temp\a.bmp")
End With
' red
Set ctrl = .Controls.Add(msoControlButton, , , , True)
With ctrl
.BeginGroup = True
.Caption = "Red"
.State = msoButtonUp
.Style = msoButtonCaption
.OnAction = "Macro ""color_red"""
End With
'yellow
Set ctrl = .Controls.Add(msoControlButton, , , , True)
With ctrl
.BeginGroup = True
.Caption = "Yellow"
.State = msoButtonUp
.Style = msoButtonCaption
.OnAction = "Macro ""color_yellow"""
End With
'green
Set ctrl = .Controls.Add(msoControlButton, , , , True)
With ctrl
.BeginGroup = True
.Caption = "Green"
.State = msoButtonUp
.Style = msoButtonCaption
.OnAction = "Macro ""color_green"""
End With
'blue
Set ctrl = .Controls.Add(msoControlButton, , , , True)
With ctrl
.BeginGroup = True
.Caption = "Blue"
.State = msoButtonUp
.Style = msoButtonCaption
.OnAction = "Macro ""color_blue"""
End With
'Darkblue
Set ctrl = .Controls.Add(msoControlButton, , , , True)
With ctrl
.BeginGroup = True
.Caption = "Darkblue"
.State = msoButtonUp
.Style = msoButtonCaption
.OnAction = "Macro ""color_darkblue"""
End With
'fushia
Set ctrl = .Controls.Add(msoControlButton, , , , True)
With ctrl
.BeginGroup = True
.Caption = "Fushia"
.State = msoButtonUp
.Style = msoButtonCaption
.OnAction = "Macro ""color_fushia"""
End With
End With
Set ctrl = Nothing
End Sub
Sub color_x(x)
Set ts = ActiveSelection.Tasks
For Each tsk In ts
FontEx CellColor:=x
Next tsk
End Sub
Sub color_red()
Call color_x(1)
End Sub
Sub color_yellow()
Call color_x(2)
End Sub
Sub color_green()
Call color_x(3)
End Sub
Sub color_blue()
Call color_x(4)
End Sub
Sub color_darkblue()
Call color_x(5)
End Sub
Sub color_fushia()
Call color_x(6)
End Sub
Sub color_white()
Call color_x(7)
End Sub