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

Вход

Регистрация

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

 

= Мир MS Excel/Как обратиться к нарисованной программно кнопке на Листе. - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как обратиться к нарисованной программно кнопке на Листе. (Макросы/Sub)
Как обратиться к нарисованной программно кнопке на Листе.
Oleg34 Дата: Пятница, 07.09.2018, 09:51 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 21
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Подскажите, как обратиться к обЪекту:

[vba]
Код
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
[/vba]
Тут создается объект Buttons которому присвоено имя .Name = "Kn". Я проверяю по этому имени наличие либо отсутствие кнопки на открытом Листе, а вот, как обращаться к его свойствам: цвет, заливка и т.д.никак не пойму.
Во втором примере кнопка отрисовывается при вызове функции:
[vba]
Код
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
[/vba]
В функции Button_Add создается объект из коллекции Shape. И через .Fill я могу обращаться к его свойствам: цвет, заливка и т.д. Тут тоже пытаюсь провести проверку на наличие на активном Листе обЪекта по имени Optional ByVal ButtonName$ = "ComButt", но не получается.
И еще один вопрос (пусть простят админы) по этому обЪекту. Точнее по расположению его. Делаю программу дома. Разрешение экрана свое. Принес на тест на работу. ОбЪект отрисовывается в другом месте. Вроде в институте когда делали работы на С++, вызывал функцию кажется свойств дисплея, и через эту функцию передавали расположение обЪектов. В своем случае хотел привязать координаты к определенным ячейкам. Например Range("L1:M2"). Но как сделать, не пойму. Делал так:
[vba]
Код

ra.Left=Range("L1")
ra.Top=Range("L1")
w = ra.Width: h = ra.Height: l = ra.Left: t = ra.Top
[/vba]
компилятор и не ругается, но все равно кнопка отрисовывает в месте щелчка.
 
Ответить
СообщениеПодскажите, как обратиться к обЪекту:

[vba]
Код
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
[/vba]
Тут создается объект Buttons которому присвоено имя .Name = "Kn". Я проверяю по этому имени наличие либо отсутствие кнопки на открытом Листе, а вот, как обращаться к его свойствам: цвет, заливка и т.д.никак не пойму.
Во втором примере кнопка отрисовывается при вызове функции:
[vba]
Код
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
[/vba]
В функции Button_Add создается объект из коллекции Shape. И через .Fill я могу обращаться к его свойствам: цвет, заливка и т.д. Тут тоже пытаюсь провести проверку на наличие на активном Листе обЪекта по имени Optional ByVal ButtonName$ = "ComButt", но не получается.
И еще один вопрос (пусть простят админы) по этому обЪекту. Точнее по расположению его. Делаю программу дома. Разрешение экрана свое. Принес на тест на работу. ОбЪект отрисовывается в другом месте. Вроде в институте когда делали работы на С++, вызывал функцию кажется свойств дисплея, и через эту функцию передавали расположение обЪектов. В своем случае хотел привязать координаты к определенным ячейкам. Например Range("L1:M2"). Но как сделать, не пойму. Делал так:
[vba]
Код

ra.Left=Range("L1")
ra.Top=Range("L1")
w = ra.Width: h = ra.Height: l = ra.Left: t = ra.Top
[/vba]
компилятор и не ругается, но все равно кнопка отрисовывает в месте щелчка.

Автор - Oleg34
Дата добавления - 07.09.2018 в 09:51
_Boroda_ Дата: Пятница, 07.09.2018, 09:58 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
- Прочитайте Правила форума
- Приложите файл с исходными данными и желаемым результатом (можно вручную) в формате Excel размером до 100кб согласно п.3 Правил форума
И еще один вопрос (пусть простят админы)

Админы, может, и простят, а вот модеры нет
- п.4 Правил форума: один вопрос - одна тема


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение- Прочитайте Правила форума
- Приложите файл с исходными данными и желаемым результатом (можно вручную) в формате Excel размером до 100кб согласно п.3 Правил форума
И еще один вопрос (пусть простят админы)

Админы, может, и простят, а вот модеры нет
- п.4 Правил форума: один вопрос - одна тема

Автор - _Boroda_
Дата добавления - 07.09.2018 в 09:58
KuklP Дата: Пятница, 07.09.2018, 10:49 | Сообщение № 3
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Oleg34, Вы чудите. На Программерс задаете этот же вопрос, хотя он к теме не относится. Тут создаете тему с ним же не сообщая о кроспостинге. Так не стоит делать. На первый вопрос(попутно и на второй):
В модуль книги:
[vba]
Код
[vba][code]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
    If ShpExist("ComButt", Sh) Then Exit Sub
    Button_Add Sh.[d3], vbGreen, "обработать данные"
End Sub
[/vba]
В общий модуль:
[vba]
Код
Function ShpExist(ShpName As String, Sh As Worksheet) As Boolean
'Возвращает ИСТИНА, если объект существует
    Dim x As Object
    On Error Resume Next
    Set x = Sh.Shapes(ShpName)
    ShpExist = (Err = 0)
End Function
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
'созданной кнопке назначаем макрос Расчет_выработки
    Dim w&, h&, l&, t&
    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    ' оформляем автофигуру
        .Name = "ComButt"
        .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]


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728


Сообщение отредактировал KuklP - Пятница, 07.09.2018, 10:51
 
Ответить
СообщениеOleg34, Вы чудите. На Программерс задаете этот же вопрос, хотя он к теме не относится. Тут создаете тему с ним же не сообщая о кроспостинге. Так не стоит делать. На первый вопрос(попутно и на второй):
В модуль книги:
[vba]
Код
[vba][code]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
    If ShpExist("ComButt", Sh) Then Exit Sub
    Button_Add Sh.[d3], vbGreen, "обработать данные"
End Sub
[/vba]
В общий модуль:
[vba]
Код
Function ShpExist(ShpName As String, Sh As Worksheet) As Boolean
'Возвращает ИСТИНА, если объект существует
    Dim x As Object
    On Error Resume Next
    Set x = Sh.Shapes(ShpName)
    ShpExist = (Err = 0)
End Function
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
'созданной кнопке назначаем макрос Расчет_выработки
    Dim w&, h&, l&, t&
    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    ' оформляем автофигуру
        .Name = "ComButt"
        .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]

Автор - KuklP
Дата добавления - 07.09.2018 в 10:49
Oleg34 Дата: Пятница, 07.09.2018, 10:53 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 21
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
KuklP, извиняюсь, но там никто не помог. В следующий раз обязательно буду сообщать о кроспостинге. И еще раз огромное Вам спасибо!!!
 
Ответить
СообщениеKuklP, извиняюсь, но там никто не помог. В следующий раз обязательно буду сообщать о кроспостинге. И еще раз огромное Вам спасибо!!!

Автор - Oleg34
Дата добавления - 07.09.2018 в 10:53
KuklP Дата: Пятница, 07.09.2018, 10:56 | Сообщение № 5
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
[offtop]Потому и не помог, что вопрос не по теме и Вы обращались ко мне конкретно. Воспитанные люди не лезут в чужие разговоры. Хотите помощи от форума - обращайтесь к форуму.[/offtop]


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
Сообщение[offtop]Потому и не помог, что вопрос не по теме и Вы обращались ко мне конкретно. Воспитанные люди не лезут в чужие разговоры. Хотите помощи от форума - обращайтесь к форуму.[/offtop]

Автор - KuklP
Дата добавления - 07.09.2018 в 10:56
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как обратиться к нарисованной программно кнопке на Листе. (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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