Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Запуск функции для отрисовки кнопки на листе - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Запуск функции для отрисовки кнопки на листе (Макросы/Sub)
Запуск функции для отрисовки кнопки на листе
Oleg34 Дата: Четверг, 23.08.2018, 18:57 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Здравствуйте! Появилась необходимость отрисовки кнопки и привязки к ней макроса в рабочей Книге по условию. Условие - это прорисовывать кнопку на Листе при открытии и только если в названии Листа цифра 1, 2, 3,... и т.д. На просторах интернета нашел два варианта. Но не получается вызвать функцию, ругается на неопознанные переменные w, h, l, t
Вот первый вариант:[vba]
Код

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
[/vba]

Вот второй вариант очень похож:
[vba]
Код

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

[/vba]


Сообщение отредактировал Oleg34 - Четверг, 23.08.2018, 18:58
 
Ответить
СообщениеЗдравствуйте! Появилась необходимость отрисовки кнопки и привязки к ней макроса в рабочей Книге по условию. Условие - это прорисовывать кнопку на Листе при открытии и только если в названии Листа цифра 1, 2, 3,... и т.д. На просторах интернета нашел два варианта. Но не получается вызвать функцию, ругается на неопознанные переменные w, h, l, t
Вот первый вариант:[vba]
Код

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
[/vba]

Вот второй вариант очень похож:
[vba]
Код

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

[/vba]

Автор - Oleg34
Дата добавления - 23.08.2018 в 18:57
RAN Дата: Четверг, 23.08.2018, 19:07 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4831
Репутация: 968 ±
Замечаний: 0% ±

2010
ругается на неопознанные переменные

Не неопознанные, а не объявленные
Отключить
[vba]
Код
Option Explicit
[/vba]
не совсем правильно, но поможет
Объявить переменные
[vba]
Код
Dim w#, h#, l#, t#
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение
ругается на неопознанные переменные

Не неопознанные, а не объявленные
Отключить
[vba]
Код
Option Explicit
[/vba]
не совсем правильно, но поможет
Объявить переменные
[vba]
Код
Dim w#, h#, l#, t#
[/vba]

Автор - RAN
Дата добавления - 23.08.2018 в 19:07
Oleg34 Дата: Четверг, 23.08.2018, 21:21 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
RAN, Да, помогло. Но почему вызов функции срабатывает после нескольких щелчков по ячейкам?


Сообщение отредактировал Oleg34 - Четверг, 23.08.2018, 21:22
 
Ответить
СообщениеRAN, Да, помогло. Но почему вызов функции срабатывает после нескольких щелчков по ячейкам?

Автор - Oleg34
Дата добавления - 23.08.2018 в 21:21
KuklP Дата: Пятница, 24.08.2018, 20:23 | Сообщение № 4
Группа: Проверенные
Ранг: Старожил
Сообщений: 2353
Репутация: 481 ±
Замечаний: 0% ±

2003-2010
На Программерс ответил.


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеНа Программерс ответил.

Автор - KuklP
Дата добавления - 24.08.2018 в 20:23
Oleg34 Дата: Пятница, 24.08.2018, 23:02 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
KuklP, огромнейшее!
 
Ответить
СообщениеKuklP, огромнейшее!

Автор - Oleg34
Дата добавления - 24.08.2018 в 23:02
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Запуск функции для отрисовки кнопки на листе (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2018 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!