두 개체 사이 거리를 다른 개체에 복사 적용

관련:  지식인

 

두 개의 도형간의 거리를 복사해서 다른 도형도 같은 거리로 만들고 싶다는 질문입니다.

크기가 같은 도형인지, 가로간격/세로간격 등 어떤 간격을 말씀하시는지 등

더 구체적인 조건은 명시하지 않았는데 어쨋든 방법을 찾아보았습니다.

​

​

기본 기능으로는 스마트 가이드를 켜고

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

 

매크로 파일:

MatchDistnace1.pptm

0.05MB

AutoHotkey 스크립트:

MatchDistancce1.ahk

0.00MB

AutoHotkey 실행파일:

MatchDistancce1.exe

1.20MB