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

Вход

Регистрация

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

 

= Мир MS Excel/Как определить направление стрелочки. - Мир MS Excel

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

Excel 2013
Здравствуйте, гуру экселя.

Столкнулся с непростым вопросом.
Помогите его решить.

На рисунке нарисована простая стрелочка "Прямая со стрелкой 2".
Координаты обеих концов этой стрелочки можно менять.

Как макросом определить куда она направлена в настоящий момент - вверх, вниз, вправо или влево и вывести это приблизительное направление (слово) в ячейку E2 ?

(Пытался разобраться сам, но заметил, что эксель воспринимает эту стрелочку, как обычный отрезок - у которого один конец неотличим от другого.)
(интересует именно та стрелочка, которая уже находится на листе)
К сообщению приложен файл: 34745-8691.xls (35.5 Kb)
 
Ответить
СообщениеЗдравствуйте, гуру экселя.

Столкнулся с непростым вопросом.
Помогите его решить.

На рисунке нарисована простая стрелочка "Прямая со стрелкой 2".
Координаты обеих концов этой стрелочки можно менять.

Как макросом определить куда она направлена в настоящий момент - вверх, вниз, вправо или влево и вывести это приблизительное направление (слово) в ячейку E2 ?

(Пытался разобраться сам, но заметил, что эксель воспринимает эту стрелочку, как обычный отрезок - у которого один конец неотличим от другого.)
(интересует именно та стрелочка, которая уже находится на листе)

Автор - SergVrn
Дата добавления - 12.10.2017 в 16:37
Саня Дата: Четверг, 12.10.2017, 20:25 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 1068
Репутация: 560 ±
Замечаний: 0% ±

XL 2016
[vba]
Код
Option Explicit

Type POINT
    x As Double
    y As Double
End Type

Type VECTOR
    v_x As Double
    v_y As Double
End Type

Sub test()
    Dim shp As Shape, vctRes As VECTOR, i As Integer
    For Each shp In ActiveSheet.Shapes
        'Stop
        i = i + 1
        
        If fGetArrowData(shp, vctRes) Then
            With Range("A" & i)
                .Value = shp.Name
                .Offset(, 1).Value = vctRes.v_x
                .Offset(, 2).Value = vctRes.v_y
            
            End With
            '''Debug.Print , vctRes.v_y
        End If
    Next shp
End Sub

Function fGetArrowData(shp As Shape, vctRes As VECTOR) As Boolean
    On Error GoTo errHandler
    Dim fRet As Boolean
    
    Dim apntDots(0 To 1) As POINT
    Dim fNormDirection As Boolean
    
    With shp
        If .HorizontalFlip = msoFalse Then
            apntDots(0).x = .Left
            apntDots(1).x = .Left + .Width
        Else
            apntDots(0).x = .Left + .Width
            apntDots(1).x = .Left
        End If
        
        If .VerticalFlip = msoFalse Then
            apntDots(0).y = .Top
            apntDots(1).y = .Top + .Height
        Else
            apntDots(0).y = .Top + .Height
            apntDots(1).y = .Top
        End If
        
        fNormDirection = (.Line.BeginArrowheadStyle = msoArrowheadNone)
    End With
    
    With vctRes
        .v_x = apntDots(1).x - apntDots(0).x
        .v_y = apntDots(1).y - apntDots(0).y
        
        If Not fNormDirection Then
            .v_x = -.v_x
            .v_y = -.v_y
        End If
    End With
    
    fRet = True
    
exitHere:
    fGetArrowData = fRet
    Exit Function
    
errHandler:
    fRet = False
    Resume exitHere
End Function
[/vba]

ps

ось y направлена вниз
К сообщению приложен файл: 6610970.xls (39.5 Kb)


Сообщение отредактировал Саня - Четверг, 12.10.2017, 20:31
 
Ответить
Сообщение[vba]
Код
Option Explicit

Type POINT
    x As Double
    y As Double
End Type

Type VECTOR
    v_x As Double
    v_y As Double
End Type

Sub test()
    Dim shp As Shape, vctRes As VECTOR, i As Integer
    For Each shp In ActiveSheet.Shapes
        'Stop
        i = i + 1
        
        If fGetArrowData(shp, vctRes) Then
            With Range("A" & i)
                .Value = shp.Name
                .Offset(, 1).Value = vctRes.v_x
                .Offset(, 2).Value = vctRes.v_y
            
            End With
            '''Debug.Print , vctRes.v_y
        End If
    Next shp
End Sub

Function fGetArrowData(shp As Shape, vctRes As VECTOR) As Boolean
    On Error GoTo errHandler
    Dim fRet As Boolean
    
    Dim apntDots(0 To 1) As POINT
    Dim fNormDirection As Boolean
    
    With shp
        If .HorizontalFlip = msoFalse Then
            apntDots(0).x = .Left
            apntDots(1).x = .Left + .Width
        Else
            apntDots(0).x = .Left + .Width
            apntDots(1).x = .Left
        End If
        
        If .VerticalFlip = msoFalse Then
            apntDots(0).y = .Top
            apntDots(1).y = .Top + .Height
        Else
            apntDots(0).y = .Top + .Height
            apntDots(1).y = .Top
        End If
        
        fNormDirection = (.Line.BeginArrowheadStyle = msoArrowheadNone)
    End With
    
    With vctRes
        .v_x = apntDots(1).x - apntDots(0).x
        .v_y = apntDots(1).y - apntDots(0).y
        
        If Not fNormDirection Then
            .v_x = -.v_x
            .v_y = -.v_y
        End If
    End With
    
    fRet = True
    
exitHere:
    fGetArrowData = fRet
    Exit Function
    
errHandler:
    fRet = False
    Resume exitHere
End Function
[/vba]

ps

ось y направлена вниз

Автор - Саня
Дата добавления - 12.10.2017 в 20:25
SergVrn Дата: Четверг, 12.10.2017, 21:11 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 87
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Саня, не подскажете - как работает ваш макрос ?

Я меняю положение стрелки - но в в ячейку E2, по прежнему - вписан один и тот же результат "право-верх".
 
Ответить
СообщениеСаня, не подскажете - как работает ваш макрос ?

Я меняю положение стрелки - но в в ячейку E2, по прежнему - вписан один и тот же результат "право-верх".

Автор - SergVrn
Дата добавления - 12.10.2017 в 21:11
K-SerJC Дата: Пятница, 13.10.2017, 11:25 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 487
Репутация: 86 ±
Замечаний: 0% ±

Excel 2013
Я меняю положение стрелки - но в в ячейку E2

поставьте в ячейку E2 формулу:
Код
=СЦЕПИТЬ(ЕСЛИ(B1=0;"_";ЕСЛИ(B1<0;"влево";"вправо"));" - ";ЕСЛИ(C1=0;"_";ЕСЛИ(C1<0;"вверх";"вниз")))


Благими намерениями выстелена дорога в АД.

Сообщение отредактировал K-SerJC - Пятница, 13.10.2017, 11:38
 
Ответить
Сообщение
Я меняю положение стрелки - но в в ячейку E2

поставьте в ячейку E2 формулу:
Код
=СЦЕПИТЬ(ЕСЛИ(B1=0;"_";ЕСЛИ(B1<0;"влево";"вправо"));" - ";ЕСЛИ(C1=0;"_";ЕСЛИ(C1<0;"вверх";"вниз")))

Автор - K-SerJC
Дата добавления - 13.10.2017 в 11:25
SergVrn Дата: Пятница, 13.10.2017, 12:10 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 87
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Саня, K-SerJC, так... я кажется понял как работает эта хитрая система.
Всем спасибо за ответы.
 
Ответить
СообщениеСаня, K-SerJC, так... я кажется понял как работает эта хитрая система.
Всем спасибо за ответы.

Автор - SergVrn
Дата добавления - 13.10.2017 в 12:10
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как определить направление стрелочки. (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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