Добрый вечер, мастера программирования. Помогите решить проблему.
На листе находится множество разных фигур. Есть макрос который двигает одну фигуру - то в ячейку, то в определенную фигуру.
Как макросом по щелчку - передвинуть любую выделенную фигуру, к той ячейке, в которую совершен щелчок после выделения фигуры ? (То есть - я щелкаю по любой фигуре, затем щелкаю по произвольной ячейке - и фигура по которой был сделан щелчок - едет в ту ячейку.)
Добрый вечер, мастера программирования. Помогите решить проблему.
На листе находится множество разных фигур. Есть макрос который двигает одну фигуру - то в ячейку, то в определенную фигуру.
Как макросом по щелчку - передвинуть любую выделенную фигуру, к той ячейке, в которую совершен щелчок после выделения фигуры ? (То есть - я щелкаю по любой фигуре, затем щелкаю по произвольной ячейке - и фигура по которой был сделан щелчок - едет в ту ячейку.)cerber412
Как вариант назначить макрос всем фигурам (и тем, кого перемещаем, и тем куда). [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]
Как вариант назначить макрос всем фигурам (и тем, кого перемещаем, и тем куда). [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
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- глобальная переменная.
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