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

Вход

Регистрация

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

 

= Мир MS Excel/Перемещение любой фигуры в произвольную ячейку - Мир MS Excel

  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Перемещение любой фигуры в произвольную ячейку
cerber412 Дата: Понедельник, 25.09.2017, 18:44 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 131
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Добрый вечер, мастера программирования.
Помогите решить проблему.

На листе находится множество разных фигур.
Есть макрос который двигает одну фигуру - то в ячейку, то в определенную фигуру.

Как макросом по щелчку - передвинуть любую выделенную фигуру, к той ячейке, в которую совершен щелчок после выделения фигуры ?
(То есть - я щелкаю по любой фигуре, затем щелкаю по произвольной ячейке - и фигура по которой был сделан щелчок - едет в ту ячейку.)
К сообщению приложен файл: 1265756.xlsm (22.8 Kb)
 
Ответить
СообщениеДобрый вечер, мастера программирования.
Помогите решить проблему.

На листе находится множество разных фигур.
Есть макрос который двигает одну фигуру - то в ячейку, то в определенную фигуру.

Как макросом по щелчку - передвинуть любую выделенную фигуру, к той ячейке, в которую совершен щелчок после выделения фигуры ?
(То есть - я щелкаю по любой фигуре, затем щелкаю по произвольной ячейке - и фигура по которой был сделан щелчок - едет в ту ячейку.)

Автор - cerber412
Дата добавления - 25.09.2017 в 18:44
nilem Дата: Понедельник, 25.09.2017, 19:41 | Сообщение № 2
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
а если так:
щелкаем по фигуре (просто ЛКМ), а потом делаем двойной клик в ячейке, куда надо переместить щелкнутую фигуру
К сообщению приложен файл: _1265756.xlsm (26.4 Kb)


Яндекс.Деньги 4100159601573
 
Ответить
Сообщениеа если так:
щелкаем по фигуре (просто ЛКМ), а потом делаем двойной клик в ячейке, куда надо переместить щелкнутую фигуру

Автор - nilem
Дата добавления - 25.09.2017 в 19:41
Roman777 Дата: Понедельник, 25.09.2017, 19:52 | Сообщение № 3
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Как вариант назначить макрос всем фигурам (и тем, кого перемещаем, и тем куда).
[vba]
Код
Public name1 As String
Sub saveName_and_move()
    Dim r
    If name1 = "" Then
        name1 = Application.Caller
        Exit Sub
    Else
        MsgBox name1
        If name1 <> Application.Caller Then
            Call Obj1ToObj2(ActiveSheet.Shapes(name1), ActiveSheet.Shapes(Application.Caller))
            name1 = ""
        End If
    End If
    Debug.Print name1
End Sub
[/vba]
К сообщению приложен файл: 1265756_.xlsm (26.8 Kb)


Много чего не знаю!!!!
 
Ответить
СообщениеКак вариант назначить макрос всем фигурам (и тем, кого перемещаем, и тем куда).
[vba]
Код
Public name1 As String
Sub saveName_and_move()
    Dim r
    If name1 = "" Then
        name1 = Application.Caller
        Exit Sub
    Else
        MsgBox name1
        If name1 <> Application.Caller Then
            Call Obj1ToObj2(ActiveSheet.Shapes(name1), ActiveSheet.Shapes(Application.Caller))
            name1 = ""
        End If
    End If
    Debug.Print name1
End Sub
[/vba]

Автор - Roman777
Дата добавления - 25.09.2017 в 19:52
cerber412 Дата: Понедельник, 25.09.2017, 21:11 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 131
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Roman777, что-то я не понял как это работает.
Щелкаю по фигуре, затем по ячейке.... и фигура стоит на месте.

Иногда вылетает сообщение с названием фигуры.
 
Ответить
СообщениеRoman777, что-то я не понял как это работает.
Щелкаю по фигуре, затем по ячейке.... и фигура стоит на месте.

Иногда вылетает сообщение с названием фигуры.

Автор - cerber412
Дата добавления - 25.09.2017 в 21:11
cerber412 Дата: Понедельник, 25.09.2017, 21:12 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 131
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
nilem, посмотрел ваш макрос.
В целом - очень даже неплохо.
Только щелчок должен быть не двойной, а одинарный.
 
Ответить
Сообщениеnilem, посмотрел ваш макрос.
В целом - очень даже неплохо.
Только щелчок должен быть не двойной, а одинарный.

Автор - cerber412
Дата добавления - 25.09.2017 в 21:12
Roman777 Дата: Понедельник, 25.09.2017, 22:16 | Сообщение № 6
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
cerber412, не правильно увидел задание. В 3-ем сообщении фигура будет плыть во вторую фигуру, если вы нажмете сначала на 1, потом на 2-ю.
Сейчас прикладываю, вроде как хотели.
В модуль листа
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If name1 = "" Then
        Exit Sub
    Else
        Call GotoCell2(name1, Target.Address)
        name1 = ""
    End If
End Sub
[/vba]
В модуле обычном
[vba]
Код
Sub GotoCell2(name2 As String, addr As String)
  With Лист1
    Obj1ToObj2 .Shapes(name2), .Range(addr)
  End With
End Sub
[/vba]
а на фигурах висит:
[vba]
Код
Sub saveName_and_move()
    Dim r
    If name1 = "" Then
        name1 = Application.Caller
        Exit Sub
    End If
    'Debug.Print name1
End Sub
[/vba]
где name1- глобальная переменная.
К сообщению приложен файл: 1265756_2.xlsm (28.1 Kb)


Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Понедельник, 25.09.2017, 22:17
 
Ответить
Сообщениеcerber412, не правильно увидел задание. В 3-ем сообщении фигура будет плыть во вторую фигуру, если вы нажмете сначала на 1, потом на 2-ю.
Сейчас прикладываю, вроде как хотели.
В модуль листа
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If name1 = "" Then
        Exit Sub
    Else
        Call GotoCell2(name1, Target.Address)
        name1 = ""
    End If
End Sub
[/vba]
В модуле обычном
[vba]
Код
Sub GotoCell2(name2 As String, addr As String)
  With Лист1
    Obj1ToObj2 .Shapes(name2), .Range(addr)
  End With
End Sub
[/vba]
а на фигурах висит:
[vba]
Код
Sub saveName_and_move()
    Dim r
    If name1 = "" Then
        name1 = Application.Caller
        Exit Sub
    End If
    'Debug.Print name1
End Sub
[/vba]
где name1- глобальная переменная.

Автор - Roman777
Дата добавления - 25.09.2017 в 22:16
cerber412 Дата: Понедельник, 25.09.2017, 22:46 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 131
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
nilem, Roman777, ваши макросы работают.
Большое спасибо за ответы.
 
Ответить
Сообщениеnilem, Roman777, ваши макросы работают.
Большое спасибо за ответы.

Автор - cerber412
Дата добавления - 25.09.2017 в 22:46
  • Страница 1 из 1
  • 1
Поиск:

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