두 개체 사이 거리를 다른 개체에 복사 적용
관련: 지식인
두 개의 도형간의 거리를 복사해서 다른 도형도 같은 거리로 만들고 싶다는 질문입니다.
크기가 같은 도형인지, 가로간격/세로간격 등 어떤 간격을 말씀하시는지 등
더 구체적인 조건은 명시하지 않았는데 어쨋든 방법을 찾아보았습니다.
기본 기능으로는 스마트 가이드를 켜고
A와 B도형 위치로 일단 C와 D를 옮겼다가 다시 원래 위치쪽으로 가져가는 방법을 써야겠습니다.
자주 써야 하는 기능이라면 아래와 같은 VBA를 이용할 수 있습니다.
Alt-F11 창에서 삽입 > 모듈 추가후 코드를 넣고
기준이 되는 두 도형을 선택하고 getDistance 를 실행해서 가로와 세로 간격을 구하고 나서
다시 새로운 C와 D도형을 선택하고 MatchDistace 를 실행하면 기억해둔 가로 간격과 세로 간격으로 두번째 도형의 위치를 변경해 줍니다.
그런데 서로 다른 크기의 도형이라면 변수가 있습니다.
도형의 끝에서 끝까지 거리인지 아니면 도형의 중심을 기준으로 한 거리인지 기준이 필요합니다.
여기서는 두 도형의 중심을 기준으로 서로 간의 가로/세로거리를 측정해서 맞추도록 했습니다.
실행화면:
사용 코드:
Dim hd As Single, vd As Single
Sub GetDistance()
Dim sr As ShapeRange
On Error Resume Next
Set sr = ActiveWindow.Selection.ShapeRange
If sr.Count <> 2 Then MsgBox "2개의 개체를 선택하세요.": Exit Sub
hd = Abs(sr(2).Left + sr(2).Width / 2 - (sr(1).Left + sr(1).Width / 2))
vd = Abs(sr(2).Top + sr(2).Height / 2 - (sr(1).Top + sr(1).Height / 2))
Debug.Print hd, vd
End Sub
Sub MatchDistance()
Dim sr As ShapeRange
On Error Resume Next
Set sr = ActiveWindow.Selection.ShapeRange
If sr.Count <> 2 Then MsgBox "2개의 개체를 선택하세요.": Exit Sub
If hd = 0 And vd = 0 Then MsgBox "GetDistance로 먼저 거리를 측정하세요.": Exit Sub
sr(2).Left = sr(1).Left + sr(1).Width / 2 + hd - sr(2).Width / 2
sr(2).Top = sr(1).Top + sr(1).Height / 2 + vd - sr(2).Height / 2
End Sub
매크로를 빠른 실행에 추가해서 Alt+숫자키로 실행할 수 있습니다.
항상 필요한 기능이라면 추가기능으로 만들어서 리본메뉴에 추가할 수 있습니다.
Autohotkey로 두 기능을 단축키로 만들 수도 있습니다.
일단 매크로 샘플 첨부합니다.
********************
시간을 더 내서 AutoHotkey 로 만들어 보았습니다.
1. 첨부한 실행파일을 실행합니다.
2. 확인을 누르면 상태표시줄로 축소됩니다.
3. 파워포인트 슬라이드에서 A, B 두 개체를 선택하고 [F3] 키를 누릅니다.
그러면 상태표시줄 아이콘이 바뀝니다.
4. 이제 새로운 C와 D 도형을 선택하고 [F4]를 누르면 됩니다.
연속적으로 A->B ->C -> D -> E 순으로 적용하면 계속 같은 위치로 옮길 수도 있습니다.
소스는 ahk 파일을 참고하세요.
#NoEnv ; Recommended for performance and compatibility with future AutoHotkey releases.
; #Warn ; Enable warnings to assist with detecting common errors.
SendMode Input ; Recommended for new scripts due to its superior speed and reliability.
SetWorkingDir %A_ScriptDir% ; Ensures a consistent starting directory.
CoordMode, Pixel, Screen
#SingleInstance
;; Scroll PowerPoint Slideview
MsgBox, 0x40, Match distance, Select two objects and press <F3>/<F4> to get/set the distance between the two objects.`n`nPress <Win+x> to quit.
;Menu, Tray, Icon,, %A_ScriptFullPath%, 1
Menu, Tray, Icon, shell32.dll, 251
Menu, Tray, Tip, [F3] get the distance [F4] Apply the distance [Win+X]: Exit
Menu, Tray, NoStandard
Menu, Tray, Add, Exit, ExitMenu
return
F3::
ppt:=ComObjActive("PowerPoint.Application")
ppt.Visible := True
IfWinActive, ahk_exe POWERPNT.EXE
{
try sr := ppt.ActiveWindow.Selection.ShapeRange
catch e {
MsgBox,2개의 개체를 선택하세요
return
}
If (sr.Count != 2) {
MsgBox,2개의 개체를 선택하세요
return
}
hd := Abs(sr.item(2).Left + sr.item(2).Width / 2 - (sr.item(1).Left + sr.item(1).Width / 2))
vd := Abs(sr.item(2).Top + sr.item(2).Height / 2 - (sr.item(1).Top + sr.item(1).Height / 2))
Menu, Tray, Icon, shell32.dll, 296
;msgbox, %vd% %hd%
ppt:=""
}
return
F4::
ppt:=ComObjActive("PowerPoint.Application")
ppt.Visible := True
IfWinActive, ahk_exe POWERPNT.EXE
{
try sr := ppt.ActiveWindow.Selection.ShapeRange
catch e {
MsgBox,2개의 개체를 선택하세요
return
}
If (sr.Count != 2) {
MsgBox,2개의 개체를 선택하세요
return
}
If (hd = 0 and vd = 0) {
MsgBox,F3을 눌러 먼저 두 개체사이의 가로/세로 거리를 구하세요.
return
}
sr.item(2).Left := sr.item(1).Left + sr.item(1).Width / 2 + hd - sr.item(2).Width / 2
sr.item(2).Top := sr.item(1).Top + sr.item(1).Height / 2 + vd - sr.item(2).Height / 2
ppt:=""
}
return
ExitMenu:
#x::
ExitApp
매크로 파일:
AutoHotkey 스크립트:
AutoHotkey 실행파일: