Вставить кнопку управления Excel
У меня есть лист Excel, который создает пользовательскую панель инструментов. На этой панели инструментов у меня есть несколько кнопок, которые используют идентификаторы лиц, и это не проблема. У меня есть несколько кнопок, где я хотел использовать пользовательские значки. Когда я использую пользовательские значки, иногда PasteFace работает, иногда нет, и я получаю сообщение об ошибке. Я добавил следующий оператор On Error Resume, чтобы увидеть, что происходит. Иногда обе кнопки вставляются нормально, иногда только одна кнопка, иногда ни одна кнопка. Я не могу найти шаблон, чтобы он работал или не работал.
Моя панель инструментов состоит примерно из 24 кнопок и одного выпадающего списка. Одиннадцать кнопок используют собственный значок, остальные — FaceID. Некоторые кнопки могут отображаться или не отображаться в зависимости от потребностей пользователя. В приведенном ниже примере показаны 2 кнопки, которые включают или выключают штраф за еду. Я выбрал только эти 2 кнопки, потому что это первые кнопки, для которых используется собственный значок.
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
Если Resume Next не используется, ошибка может возникнуть в любом из двух операторов вставки.
Что-то в моем коде делает PastFace ненадежным?
Если PasteFace по своей сути ненадежен, есть ли способ проверить успешную вставку и повторить, если это не так?
Есть лучший способ это сделать?
Ответы 1
Рабочие листы имеют скрытые коллекции, содержащие изображения и элементы управления ActiveX. VBA также имеет скрытый тип изображения. Изображения имеют метод CopyPicture, который более последователен, чем `Shape.Copy.
Нажмите F2, чтобы открыть браузер объектов, щелкните правой кнопкой мыши и выберите Show Hidden Members
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
Я создал функции для обращения к изображениям с помощью этого макроса:
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