MyTetra Share
Делитесь знаниями!
Добавляем кнопку запуска макроса(Buttons)
Время создания: 16.03.2019 23:43
Раздел: Разные закладки - VBA
Запись: xintrea/mytetra_db_adgaver_new/master/base/1507281615thyh37t7sa/text.html на raw.githubusercontent.com

''====================================================================

''--------------------------------------------------------------------

''Добавляем кнопку запуска макроса

''--------------------------------------------------------------------

'Sub testFnAddBitton()

' 'ThisWorkbook.Sheets(strShName)

' Dim iTop As Integer, iLeft As Integer

' iTop = Range(strAddressBitton).Top

' iLeft = Range(strAddressBitton).Left

' Кнопка = m_Fn.FnAddBitton(oSh, "Сформировать список критериев", "ListMacroZone", iLeft, iTop, 220, 15)

'End Sub


'oSh - лист где добавляем

'strOnAction - имя макроса для назначения

'strCaption - надпись на кнопке

Function FnAddBitton(ByVal oSh As Worksheet, _

ByVal strCaption As String, _

Optional ByVal strOnAction As String = "", _

Optional ByVal iLeft As Integer = 50, _

Optional ByVal iTop As Integer = 5, _

Optional ByVal iWidth As Integer = 120, _

Optional ByVal iHeight As Integer = 20) As Boolean

'добавить кнопку

Dim oButton As Object

Set oButton = oSh.Buttons.Add(iLeft, iTop, iWidth, iHeight)

' ThisWorkbook.Sheets(strShName).Buttons.Add(287.25, 18.75, 133.5, 30).Select

With oButton

.OnAction = strOnAction '"Tt"

.Characters.Text = strCaption '"Обновить"

.Placement = xlFreeFloating 'не изменять размеры

.PrintObject = False 'выводить на печать

End With

Set oButton = Nothing


'проверка ошибки

If Len(Error$) > 0 Then

FnAddBitton = False

Else

FnAddBitton = True

End If

Err.Clear

'Шрифт

' Selection.OnAction = "ListMacroZone"

' Selection.Characters.Text = "Сформировать список зон" '& Chr(10) & ""

' With Selection.Characters(Start:=1, Length:=11).Font

' .Name = "Body Font"

' .FontStyle = "обычный"

' .Size = 8

' .Strikethrough = False

' .Superscript = False

' .Subscript = False

' .OutlineFont = False

' .Shadow = False

' .Underline = xlUnderlineStyleNone

' .ColorIndex = 1

' End With

'Размеры

' ActiveSheet.Shapes.Range(Array("Button 3")).Select

' ActiveSheet.Shapes("Button 3").ScaleWidth 0.4181820303, msoFalse, _

' msoScaleFromTopLeft

' ActiveSheet.Shapes("Button 3").ScaleHeight 0.3608247423, msoFalse, _

' msoScaleFromTopLeft


End Function

'====================================================================

Так же в этом разделе:
 
MyTetra Share v.0.65
Яндекс индекс цитирования