Новости:

Теперь на форум можно залогиниться / зарегистрироваться с помощью ВКонтакте. Уже существующие пользователи могут связать свою учетную запись с аккаунтом ВКонтакте одним кликом в профиле пользователя http://forum.msexcel.ru/index.php?action=profile;area=account

Главное меню

в переменную выделенный Shape

Автор GWolf, 30.12.2021, 20:17

« назад - далее »

GWolf

С наступающим Новым годом, друзья!
Всем добра и здоровья!
Есть задача: На листе, находится Круг, созданный через Панель рисования. Я его выделяю мышкой и ... хотелось бы, чтобы этот объект передавался в переменную.
Но, не получается. Может кто знает, как это сделать?
Путей к вершине - множество. Этот один из многих!

GWolf

#1
Теперь уже с Наступившим!
Решил задачу вот так:    Dim s1 As Object
    Set s1 = ActiveWindow.Selection.ShapeRange


ну т.е.: Sub test()
    Dim s1 As Object
    Dim zn%
   
    '==================
    '
    'вот сюда нужно бы организовать проверку на выделено или
    'не выделено что либо на листе из Shape - объектов
    'И если ничего не выделено, то и Exit Sub
    '
    '==================

    Set s1 = ActiveWindow.Selection.ShapeRange

    With s1
        MsgBox "Выделен рисованый объект:" & Chr(10) & _
               " - имя: " & .Name & Chr(10) & _
               " - надпись: " & .TextEffect.Text & Chr(10) & _
               " - тип объекта: " & .Type & Chr(10) & _
               "Размещение:" & Chr(10) & _
               "  - вниз = " & .Top & Chr(10) & _
               "  - в право = " & .Left & Chr(10) & _
               "Размеры объекта:" & Chr(10) & _
               "    - высота = " & .Height & Chr(10) & _
               "    - длина = " & .Width, vbInformation + vbOKOnly, ""
    End With
   
    zn = CInt(InputBox(Prompt:="Я могу Повернуть объект." & Chr(10) & _
                               "Укажите градус поворота: ", Title:="", Default:="0"))
    If zn = 0 Then
        Exit Sub
    Else
        s1.Rotation = zn
    End If
End Sub

но, есть еще вопрос: если ни одна фигура не выбрана - выдает ошибку.
Как решить, пока не знаю. Может кто подскажет?
Путей к вершине - множество. Этот один из многих!

GWolf

Доброго времени суток, друзья!
Нашел я, таки решение:
Sub test()
    '==================
    '
    'вот сюда нужно бы организовать проверку на выделено или
    'не выделено что либо на листе из Shape - объектов
    'И если ничего не выделено, то и Exit Sub
    '
    '==================
    If TypeName(Selection) = "Range" Then MsgBox "Не выбран ни один рисованный объект.", vbCritical + vbOKOnly, "Аварийный выход!": Exit Sub
   
    Dim s1 As Object: Dim zn As Variant
   
    Set s1 = ActiveWindow.Selection.ShapeRange
    ...

проверил, вроде работает.
Путей к вершине - множество. Этот один из многих!

nilem

или типа такого:
If TypeName(Selection) = "Oval" Then MsgBox "Выбран круг"

GWolf

Доброго времени суток!
Большое спасибо, уважаемый nilem, вы подтвердили мое решение!
Путей к вершине - множество. Этот один из многих!

boa

#5
Привет, Вульф
как вариант, подобраться к рисункам...

  Dim oShap As Shapes
  Dim oShapStep1 As Object, oShapStep2 As Shape
  Set oShap = ActiveSheet.Shapes

For Each oShapStep1 In Application.Selection
  For Each oShapStep2 In oShap
      If oShapStep1.Name = oShapStep2.Name Then Stop: MsgBox "объект """ & oShapStep1.Name & """ выделен."
  Next
Next

Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра