Option Explicit

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    If Target.Cells.Count > 1 Then Exit Sub
        If IsNumeric(Sh.Name) Then 'если в имени листа цифра то
   'вызваю функцию Button_Add
    Button_Add Selection, vbGreen, "Обработать данные": End Sub
        End If
End Sub
Function Button_Add(ByRef ra As Range, Optional ByVal ButtonColor As Long = 255, _
                       Optional ByVal ButtonName$ = "Рассчет", Optional ByVal MacroName As String = "")
    ' функция рисует автофигуру (прямоугольник) поверх диапазона ra
    ' и окрашивает созданную кнопку (с названием ) в цвет Button_color
    ' созданной кнопке назначается макрос MacroName
    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

Option Explicit

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    If Target.Cells.Count > 1 Then Exit Sub
        If IsNumeric(Sh.Name) Then 'если в имени листа цифра то
   'вызваю функцию Button_Add
    Button_Add Selection, vbGreen, "Обработать данные"
        End If
        
End Sub
Function Button_Add(ByRef ra As Range, ByVal Button_color As Long, ByVal txt As String, _
                       Optional ByVal MacroName As String = "") As Shape
    On Error Resume Next: Err.Clear
    w = ra.Width: h = ra.Height: w = IIf(w > 10, w, 50): h = IIf(h > 10, h, 50)
    l = ra.Left: t = ra.Top:
    Dim sha As Shape: Set sha = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, l, t, w, h)
    With sha
        .Fill.Visible = msoTrue: .Fill.Solid: .Fill.ForeColor.RGB = Button_color:    '.Fill.Transparency = 0.3
        .Fill.BackColor.RGB = vbWhite:    '.Fill.TwoColorGradient msoGradientFromCenter, 2
        .Adjustments.Item(1) = 0.16: .Placement = xlFreeFloating: .OLEFormat.Object.PrintObject = False
        With .TextFrame
            .Characters.Text = txt
            With .Characters.Font
                .Size = IIf(h >= 16, 10, 8): .Bold = True: .Name = "Arial Narrow": .Name = "Arial"
            End With
            .HorizontalAlignment = xlCenter: .VerticalAlignment = xlVAlignCenter
        End With
        .OnAction = MacroName
    End With
    Set Button_Add = sha
End Function