Search code examples
excelvbaexcel-2010

Excel ControlButton Pasteface

I have an excel sheet that makes a custom toolbar. Within this toolbar, I have several buttons that use faceIDs, which are no problem. I have a few buttons where I wanted to use custom icons. When I use the custom icons, sometimes the PasteFace works, sometimes it does not, and I get an error. I added an On Error Resume next statement, to see what was happening. Sometimes both buttons paste ok, sometimes just one button, sometimes neither button. I can find no pattern to it working or not working.

My toolbar consists of approximately 24 buttons, and one drop down box. Eleven of the buttons use a custom icon, the remainder use a FaceID. Some buttons are toggled to display or not display based on user needs. The example below shows 2 buttons that will toggle to turn a meal penalty on or off. I only picked these 2 buttons because these are first buttons to use a custom icon.

  Sub Make_PayBar()
      
    Dim PayBar As CommandBar
    Dim NewButton As CommandBarButton
    
    'Delete existing PayBar toolbar if it exists
    Call Kill_PayBar
    ThisWorkbook.Activate
    On Error Resume Next
      
    'Create New PayBar
    Set PayBar = Application.CommandBars.Add(Name:="Payroll Bar", Temporary:=True)
    PayBar.Visible = True
    PayBar.Position = msoBarTop
  
    ...  Missing Code, More buttons  ...
    
    'Meal Penalty Off Button
    Set NewButton = PayBar.Controls.Add(Type:=msoControlButton, Parameter:="Meal_Off")
    NewButton.Caption = "Meal Penalty Off"
    NewButton.OnAction = "ToggleMeal"
    'NewButton.FaceId = 1254               'Backup if pasteface fails
    Sheets("Pics").Shapes("Meal_Off").Copy
    NewButton.PasteFace
      
    'Meal Penalty On Button
    Set NewButton = PayBar.Controls.Add(Type:=msoControlButton, Parameter:="Meal_On")
    NewButton.Caption = "Meal Penalty On"
    NewButton.OnAction = "ToggleMeal"
    'NewButton.FaceId = 1253               'Backup if pasteface fails
    Sheets("Pics").Shapes("Meal_On").Copy
    NewButton.PasteFace
    NewButton.Visible = False
    
    ...  Missing Code, More buttons  ...
    
  End sub

If the Resume Next is not used, the error may occurs on either of the two pasteface statements.

Is there something in my code making PastFace unreliable?

If PasteFace is inherently unreliable, is there a way to check for a successful paste, and repeat if it wasn't?

Is there a better way to do this?

Solution

  • Worksheets have hidden collections that hold pictures and ActiveX controls. The VBA also has a hidden Picture type. Pictures have a CopyPicture method that is more consistent then `Shape.Copy.

    Press F2 to open the Object Browser, right click and choose Show Hidden Members

    Object Browser

    Function picMeal_Off() As Picture: Set picMeal_Off = ThisWorkbook.Worksheets("Pics").Pictures("Meal_Off"): End Function
Function picMeal_on() As Picture: Set picMeal_on = ThisWorkbook.Worksheets("Pics").Pictures("Meal_on"): End Function

Sub Make_PayBar()
      
    Dim PayBar As CommandBar
    Dim NewButton As CommandBarButton
    Set PayBar = Application.CommandBars.Add(Name:="Payroll Bar", Temporary:=True)
    PayBar.Visible = True
    PayBar.Position = msoBarTop
  
    Set NewButton = PayBar.Controls.Add(Type:=msoControlButton, Parameter:="Meal_Off")
    NewButton.Caption = "Meal Penalty Off"
    NewButton.OnAction = "ToggleMeal"
    picMeal_Off.CopyPicture
    NewButton.PasteFace
End Sub

    I created functions to refer to the Pictures by using this macro:

    Sub PrintPitureDefs(ws As Worksheet)
    Const BaseCode As String = "Function picCodeName() As Picture:Set picCodeName = ThisWorkbook.Worksheets(""WorksheetName"").Pictures(""PictureName""):End Function"
    Dim Code As String
    Dim Img As Picture
    For Each Img In ws.Pictures
        Code = Replace(BaseCode, "WorksheetName", ws.Name)
        Code = Replace(Code, "PictureName", Img.Name)
        Code = Replace(Code, "CodeName", Replace(Img.Name, " ", "_"))
        Debug.Print Code
    Next
End Sub