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

Вход

Регистрация

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

 

= Мир MS Excel/Поворот и перемещение фигуры - Мир MS Excel

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

Excel 2013
Добрый вечер.
Имеется вопрос.

На листе - имеется четыре кнопки в виде синих стрелок (прямо,влево,вправо,назад) - и одна маленькая красная стрелка.

Кнопка "прямо" ПЕРЕМЕЩАЕТ красную стрелку - прямо на одну ячейку, кнопка "влево" - ПОВОРАЧИВАЕТ ее влево, кнопка "вправо" - ПОВОРАЧИВАЕТ ее вправо, а кнопка "назад"- ПЕРЕМЕЩАЕТ красную стрелку на одну ячейку назад.
Как заставить кнопки - так влиять на красную стрелку ?
К сообщению приложен файл: 2593972.xls(37.0 Kb)
 
Ответить
СообщениеДобрый вечер.
Имеется вопрос.

На листе - имеется четыре кнопки в виде синих стрелок (прямо,влево,вправо,назад) - и одна маленькая красная стрелка.

Кнопка "прямо" ПЕРЕМЕЩАЕТ красную стрелку - прямо на одну ячейку, кнопка "влево" - ПОВОРАЧИВАЕТ ее влево, кнопка "вправо" - ПОВОРАЧИВАЕТ ее вправо, а кнопка "назад"- ПЕРЕМЕЩАЕТ красную стрелку на одну ячейку назад.
Как заставить кнопки - так влиять на красную стрелку ?

Автор - Werwolfik
Дата добавления - 06.04.2018 в 21:16
Mikael Дата: Пятница, 06.04.2018, 22:34 | Сообщение № 2
Группа: Пользователи
Ранг: Участник
Сообщений: 80
Репутация: 31 ±
Замечаний: 0% ±

Excel 2010
Werwolfik, добрый вечер.
Так хотели?
[vba]
Код
Sub MoveShape()
    On Error Resume Next
    Dim sh As Shape: Set sh = ActiveSheet.Shapes("Down Arrow 5")
    Select Case Right(CStr(Application.Caller), 1)
        Case "1"
            sh.Rotation = sh.Rotation + 90
        Case "2"
            sh.Rotation = sh.Rotation - 90
        Case "3"
            sh.Top = sh.TopLeftCell.Offset(1).Top
        Case "4"
            sh.Top = sh.TopLeftCell.Offset(-1).Top
        Case Else
            Exit Sub
    End Select
End Sub
[/vba]
К сообщению приложен файл: ShapeMove.xls(48.0 Kb)
 
Ответить
СообщениеWerwolfik, добрый вечер.
Так хотели?
[vba]
Код
Sub MoveShape()
    On Error Resume Next
    Dim sh As Shape: Set sh = ActiveSheet.Shapes("Down Arrow 5")
    Select Case Right(CStr(Application.Caller), 1)
        Case "1"
            sh.Rotation = sh.Rotation + 90
        Case "2"
            sh.Rotation = sh.Rotation - 90
        Case "3"
            sh.Top = sh.TopLeftCell.Offset(1).Top
        Case "4"
            sh.Top = sh.TopLeftCell.Offset(-1).Top
        Case Else
            Exit Sub
    End Select
End Sub
[/vba]

Автор - Mikael
Дата добавления - 06.04.2018 в 22:34
Werwolfik Дата: Пятница, 06.04.2018, 22:49 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 26
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Mikael, это немного не то.
У вас макрос для кнопок Влево и Вправо - работает как нужно.
А вот кнопки Вперед и Назад - не двигают стрелку вперед и назад. Они ее просто перемещают вверх или вниз - по листу.

А по идее стрелка должна двигаться Вперед- то есть в том направлении куда она в настоящий момент повернута.
И Назад - то есть пятясь назад (не меняя направления) от того направления куда она в настоящий момент повернута.
 
Ответить
СообщениеMikael, это немного не то.
У вас макрос для кнопок Влево и Вправо - работает как нужно.
А вот кнопки Вперед и Назад - не двигают стрелку вперед и назад. Они ее просто перемещают вверх или вниз - по листу.

А по идее стрелка должна двигаться Вперед- то есть в том направлении куда она в настоящий момент повернута.
И Назад - то есть пятясь назад (не меняя направления) от того направления куда она в настоящий момент повернута.

Автор - Werwolfik
Дата добавления - 06.04.2018 в 22:49
doober Дата: Пятница, 06.04.2018, 22:59 | Сообщение № 4
Группа: Друзья
Ранг: Обитатель
Сообщений: 489
Репутация: 228 ±
Замечаний: 0% ±

Excel 2007
Werwolfik, здравствуйте.
А в чем сложность переделать код под себя.
Осталась геометрия.Угол наклона получить можно sh.Rotation.
Приращение координат есть, рассчитывайте новую точку.


 
Ответить
СообщениеWerwolfik, здравствуйте.
А в чем сложность переделать код под себя.
Осталась геометрия.Угол наклона получить можно sh.Rotation.
Приращение координат есть, рассчитывайте новую точку.

Автор - doober
Дата добавления - 06.04.2018 в 22:59
Werwolfik Дата: Пятница, 06.04.2018, 23:19 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 26
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
doober,
Куда именно в макросе добавлять sh.Rotation, чтобы получить нужное направление для движения стрелки Вперед ?
То есть сейчас код движения по кнопке "Вперед" - выглядит так:
[vba]
Код

sh.Top = sh.TopLeftCell.Offset(1).Top
[/vba]
Но это движение вверх, а не вперед.
Я понимаю, что вам это кажется чистой геометрией - как и мне, а вот как это технически в коде ВБА реализовать ?
 
Ответить
Сообщениеdoober,
Куда именно в макросе добавлять sh.Rotation, чтобы получить нужное направление для движения стрелки Вперед ?
То есть сейчас код движения по кнопке "Вперед" - выглядит так:
[vba]
Код

sh.Top = sh.TopLeftCell.Offset(1).Top
[/vba]
Но это движение вверх, а не вперед.
Я понимаю, что вам это кажется чистой геометрией - как и мне, а вот как это технически в коде ВБА реализовать ?

Автор - Werwolfik
Дата добавления - 06.04.2018 в 23:19
doober Дата: Суббота, 07.04.2018, 00:11 | Сообщение № 6
Группа: Друзья
Ранг: Обитатель
Сообщений: 489
Репутация: 228 ±
Замечаний: 0% ±

Excel 2007
Все в Ваших руках.
Все данные есть[vba]
Код
Sub MoveShape()
    On Error Resume Next
    Dim sh As Shape: Set sh = ActiveSheet.Shapes("Down Arrow 5")
    Dim angle As Double, X As Double, Y As Double, angleGR As Double
    angle = sh.Rotation
    angleGR = 0
    If angle <> 0 Then angleGR = WorksheetFunction.Pi * angle / 180
    Y = sh.TopLeftCell.Top
    X = sh.TopLeftCell.Left
     Dlinna = IIf(sh.DrawingObject.Width > sh.DrawingObject.Height, sh.DrawingObject.Width, sh.DrawingObject.Height)
          
    Select Case Right(CStr(Application.Caller), 1)
        Case "1"
        'Расчет
        Case "2"
          'Расчет
        Case "3"
           'Расчет
        Case "4"
         'Расчет
   
        Case Else
            Exit Sub
    End Select
End Sub
[/vba]


 
Ответить
СообщениеВсе в Ваших руках.
Все данные есть[vba]
Код
Sub MoveShape()
    On Error Resume Next
    Dim sh As Shape: Set sh = ActiveSheet.Shapes("Down Arrow 5")
    Dim angle As Double, X As Double, Y As Double, angleGR As Double
    angle = sh.Rotation
    angleGR = 0
    If angle <> 0 Then angleGR = WorksheetFunction.Pi * angle / 180
    Y = sh.TopLeftCell.Top
    X = sh.TopLeftCell.Left
     Dlinna = IIf(sh.DrawingObject.Width > sh.DrawingObject.Height, sh.DrawingObject.Width, sh.DrawingObject.Height)
          
    Select Case Right(CStr(Application.Caller), 1)
        Case "1"
        'Расчет
        Case "2"
          'Расчет
        Case "3"
           'Расчет
        Case "4"
         'Расчет
   
        Case Else
            Exit Sub
    End Select
End Sub
[/vba]

Автор - doober
Дата добавления - 07.04.2018 в 00:11
Werwolfik Дата: Суббота, 07.04.2018, 00:30 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 26
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
doober, не работает.
Все то же самое - стрелка поворачивается, но перемещаться может только вверх и вниз.


Сообщение отредактировал Werwolfik - Суббота, 07.04.2018, 00:34
 
Ответить
Сообщениеdoober, не работает.
Все то же самое - стрелка поворачивается, но перемещаться может только вверх и вниз.

Автор - Werwolfik
Дата добавления - 07.04.2018 в 00:30
Mikael Дата: Суббота, 07.04.2018, 00:33 | Сообщение № 8
Группа: Пользователи
Ранг: Участник
Сообщений: 80
Репутация: 31 ±
Замечаний: 0% ±

Excel 2010
Werwolfik, Рад что Вам понравилось.
в том направлении куда она в настоящий момент повернута

Нужно точнее описывать задачу. Я понял по-другому.
На самом деле все просто, doober, Вам все расписал в #6
 
Ответить
СообщениеWerwolfik, Рад что Вам понравилось.
в том направлении куда она в настоящий момент повернута

Нужно точнее описывать задачу. Я понял по-другому.
На самом деле все просто, doober, Вам все расписал в #6

Автор - Mikael
Дата добавления - 07.04.2018 в 00:33
Werwolfik Дата: Суббота, 07.04.2018, 00:36 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 26
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Mikael, нет в 6 сообщении - все точно также - стрелка вертится нормально.
Но перемещаться она может - только Вверх или Вниз по листу.
 
Ответить
СообщениеMikael, нет в 6 сообщении - все точно также - стрелка вертится нормально.
Но перемещаться она может - только Вверх или Вниз по листу.

Автор - Werwolfik
Дата добавления - 07.04.2018 в 00:36
doober Дата: Суббота, 07.04.2018, 00:55 | Сообщение № 10
Группа: Друзья
Ранг: Обитатель
Сообщений: 489
Репутация: 228 ±
Замечаний: 0% ±

Excel 2007
Далее геометрия.
Есть длинна отрезка, есть координаты точки, угол наклона
В зависимости от направления( Case "1", Case "2", Case "3", Case "4") считайте координату точки и угол поворота отрезка


 
Ответить
СообщениеДалее геометрия.
Есть длинна отрезка, есть координаты точки, угол наклона
В зависимости от направления( Case "1", Case "2", Case "3", Case "4") считайте координату точки и угол поворота отрезка

Автор - doober
Дата добавления - 07.04.2018 в 00:55
Werwolfik Дата: Суббота, 07.04.2018, 01:12 | Сообщение № 11
Группа: Пользователи
Ранг: Новичок
Сообщений: 26
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
doober, сейчас код движения по кнопке "Вперед" - выглядит так:
[vba]
Код

sh.Top = sh.TopLeftCell.Offset(1).Top
[/vba]

Угол наклона - это переменная angle
Длина - это переменная Dlinna
Координаты - это переменные X, Y

Куда, с точки зрения геометрии - их добавить в эту конкретную строчку кода, чтобы стрелка двинулась прямо ?
 
Ответить
Сообщениеdoober, сейчас код движения по кнопке "Вперед" - выглядит так:
[vba]
Код

sh.Top = sh.TopLeftCell.Offset(1).Top
[/vba]

Угол наклона - это переменная angle
Длина - это переменная Dlinna
Координаты - это переменные X, Y

Куда, с точки зрения геометрии - их добавить в эту конкретную строчку кода, чтобы стрелка двинулась прямо ?

Автор - Werwolfik
Дата добавления - 07.04.2018 в 01:12
doober Дата: Суббота, 07.04.2018, 01:35 | Сообщение № 12
Группа: Друзья
Ранг: Обитатель
Сообщений: 489
Репутация: 228 ±
Замечаний: 0% ±

Excel 2007
Приращения рассчитывайте в зависимости от нажатых кнопкок
sh.Top = Y ± Приращение1
sh.Left=X± Приращение2
sh.Rotation = angle ± Приращение3
Если это не понятно. читайте учебник геометрии.


 
Ответить
СообщениеПриращения рассчитывайте в зависимости от нажатых кнопкок
sh.Top = Y ± Приращение1
sh.Left=X± Приращение2
sh.Rotation = angle ± Приращение3
Если это не понятно. читайте учебник геометрии.

Автор - doober
Дата добавления - 07.04.2018 в 01:35
Werwolfik Дата: Суббота, 07.04.2018, 02:29 | Сообщение № 13
Группа: Пользователи
Ранг: Новичок
Сообщений: 26
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
doober, что такое "приращение" ?
У меня имеются только угол наклона, длина, координаты.

И я не совсем понимаю как здесь в принципе используются координаты.
Двигаться-то нужно строго НА ОДНУ ЯЧЕЙКУ, а ячейка может быть любой длины и ширины и отличаться от соседней ячейки.

Вы какие координаты имеете ввиду ?
Координаты чего - стрелки, ячейки ?


Сообщение отредактировал Werwolfik - Суббота, 07.04.2018, 02:33
 
Ответить
Сообщениеdoober, что такое "приращение" ?
У меня имеются только угол наклона, длина, координаты.

И я не совсем понимаю как здесь в принципе используются координаты.
Двигаться-то нужно строго НА ОДНУ ЯЧЕЙКУ, а ячейка может быть любой длины и ширины и отличаться от соседней ячейки.

Вы какие координаты имеете ввиду ?
Координаты чего - стрелки, ячейки ?

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

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