проверка на созданную кнопку

[Oleg34]

Здравствуйте пытаюсь прорисовать кнопку на определенных листах. Условие - Имя листа должно быть цифра. Кнопка рисуется, но при активации любой ячейки, отрисовывается снова. Пытался загнать в блок If, но не соображу, как определить, что проверять(

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim w#, h#, l#, t#
 If Target.Cells.Count > 1 Then Exit Sub
        If IsNumeric(Sh.Name) Then 'если в имени листа цифра то
    'рисуем кнопку

w = 695.75 'горизонталь
l = 440.25 'вертикаль
t = 85.25 'длина кнопки
h = 50.25 'высота кнопки

Sh.Buttons.Add(w, l, t, h).Select
Sh.Buttons.Caption = "Ok"
Cells(29, 13).Select
    End If
 End Sub

И хотел, чтобы кнопка отрисовалась при открытии Листа, но отрисовка происходит только после щелчка в ячейке.

[kuklp]

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim d As Object
    Dim w#, h#, l#, t#
    If Selection.Cells.Count > 1 Then Exit Sub
    If Not IsNumeric(Sh.Name) Then    'если в имени листа цифра то
        'рисуем кнопку
        For Each d In Sh.DrawingObjects
            If d.Name = "Kn" Then Exit Sub
        Next
        w = 695.75    'горизонталь
        l = 440.25    'вертикаль
        t = 85.25    'длина кнопки
        h = 50.25    'высота кнопки
        With Sh.Buttons.Add(w, l, t, h)
            .Caption = "Ok"
            .Name = "Kn"
        End With
        Sh.Cells(29, 13).Select
    End If
End Sub

[Oleg34]

Здравствуйте kuklp, а можете пояснить, в функции Button_Add создается объект из коллекции Shape. И через .Fill я могу обращаться к его свойствам: цвет, заливка и т.д. а в этом примере создается объект Buttons которому присвоено имя .Name = "Kn". Я проверяю по этому имени наличие либо отсутствие кнопки, а вот, как обращаться к его свойствам, никак не пойму. В случае же с вызовом функции, пытаюсь провести такую же проверку по Optional ByVal ButtonName$ = "ComButt", но не получается. И возможно ли задать расположение кнопки на Листе привязав ее к региону, например Range("L1:M2") и в первом случае и в случае с функцией?

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim d As Object
Dim w As Double
Dim h As Double
Dim l As Double
Dim t As Double

        'вызов функции Button_Add
        For Each sha In Sh.DrawingObjects
        If sha.Name = "ComButt" Then Exit Sub
        Next
        Button_Add Selection, vbGreen, "обработать данные"

End Sub

Public Function Button_Add(ByRef ra As Range, Optional ByVal ButtonColor As Long = 255, _
                    Optional ByVal ButtonName$ = "ComButt", Optional ByVal MacroName As String = "")
                    'функция рисует автофигуру поверх диапазона ra
                    'окрашивает созданную кнопку в цвет Button_color
                    'созданной кнопке назначаем макрос Расчет_выработки
    On Error Resume Next: Err.Clear
    
    w = ra.Width: h = ra.Height: l = ra.Left: t = ra.Top
    
    w = IIf(w >= 10, w, 50): h = IIf(h >= 10, h, 50)    ' не создаем маленькие кнопки 10*10

    ' добавляем кнопку на лист
    Dim sha As Shape: Set sha = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, l, t, w, h)
    With sha    ' оформляем автофигуру
        .Fill.Visible = msoTrue: .Fill.Solid
        .Fill.ForeColor.RGB = ButtonColor: .Fill.Transparency = 0.3
        .Fill.BackColor.RGB = vbWhite
        .Fill.TwoColorGradient msoGradientFromCenter, 2    ' градиентная заливка
        .Adjustments.Item(1) = 0.23: .Placement = xlFreeFloating
        .OLEFormat.Object.PrintObject = False    ' кнопки не выводятся на печать
        .Line.Weight = 0.25: .Line.ForeColor.RGB = vbBlack ' делаем тонкий черный контур
        With .TextFrame    ' добавляем и форматируем текст
            .Characters.Text = ButtonName$ ' добавляем текст
            With .Characters.Font ' изменяем начертание текста
                .Size = IIf(h >= 16, 10, 8): .Bold = True:
                .Color = vbBlack: .Name = "Arial" ' цвет и шрифт
            End With
            .HorizontalAlignment = xlCenter: .VerticalAlignment = xlVAlignCenter
        End With
        .OnAction = MacroName    ' назначаем кнопке макрос
    End With
                        
End Function