VBA:创建内存位图以在commandbarbutton上显示为图标

时间:2014-01-15 16:37:29

标签: vba bitmap microsoft-project-vba

在VBA中,我创建了一个带有按钮的自定义commmandbar,允许我在MS Project规划中设置选择行的背景颜色。

我想在每个按钮上显示16x16位图图标,而不是使用文字字幕。我可以从硬盘加载这些位图,但是想在VBA中创建它们。

这可能吗?在我的广泛研究之后,VBA中没有位图或绘图类。

现在是什么:

enter image description here

应该成为什么(手动完成):

enter image description here

代码:

'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

0 个答案:

没有答案