본문 바로가기
programming language/VBA

MS 워드 VBA 그림 폭 맞추기

by __observer__ 2012. 8. 1.
반응형

워드를 비롯한 MS 오피스 프로그램들은 VBA (Visual Basic for Applications)를 이용하여 프로그래밍을 할 수 있습니다.

 

반복되는 작업들은 VBA 를 이용하여 매크로의 형태로 만들어 놓고 단축키를 지정해서 사용한다면 문서 작업시의 생산성을 현저히 높일 수 있다고 생각합니다.

 

그런데 엑셀 관련한 VBA 내용들은 국내에도 굉장히 많은 반면에 다른 오피스 제품군들에 대해서는 이상하게도 VBA 관련한 책이나 내용들이 그리 많지 않은 것 같습니다.

 

저는 워드에 그림을 추가하는 경우가 많은데요.

 

추가된 그림들의 크기가 들쭉 날쭉하면 문서가 어딘지 모르게 예뻐 보이지 않아서 그림들의 폭을 일정하게 맞추는 편입니다.

 

그런데 이런 그림이 한 두개라면 상관 없는데 10개 넘어가면 하나 하나 맞추기가 짜증 나더군요.

 

그래서 워드 VBA 로 그림의 폭을 맞추는 코드가 있을 것 같아서 구글링을 해보니 외국의 사이트에서 해당 코드가 나오더군요.

 

코드는 다음과 같습니다. 아래 코드는 cm단위로 폭을 맞추는 코드이며 고정 비율로 그림의 크기를 조절 하므로 폭에 따라 그림의 높이는 자동으로 변환됩니다.

 

즐겨 사용하시는 폭으로 숫자를 설정해서 사용하시면 됩니다.

 

Figure_Attributes() 함수가 그림의 폭을 맞춰주는 함수이고 AspectHt() 함수는 폭에 따른 높이를 계산해 주는 함수입니다.

 

Private Function AspectHt( _

origWd As Long, origHt As Long, _

newWd As Long) As Long

If origWd <> 0 Then

AspectHt = (CSng(origHt) / CSng(origWd)) * newWd

Else

AspectHt = 0

End If

End Function

 

Sub Figure_Attributes()

 

Dim oShp As Shape

Dim oILShp As InlineShape

 

For Each oShp In ActiveDocument.Shapes

With oShp

.Height = AspectHt(.Width, .Height, _

CentimetersToPoints(8)) '원하는 숫자 입력 cm

.Width = CentimetersToPoints(8) '원하는 숫자 입력

End With

Next

 

For Each oILShp In ActiveDocument.InlineShapes

With oILShp

.Height = AspectHt(.Width, .Height, _

CentimetersToPoints(8)) '원하는 숫자 입력

.Width = CentimetersToPoints(8) '원하는 숫자 입력

End With

Next

End Sub

 

아래 그림 처럼 워드에 첨부한 두 개의 그림의 폭이 다를 때~

 

워드에서 Alt+F11 을 눌러서 Visual Basic Editor를 열고 저장하고자 하는 위치에 위의 코드들을 저장합니다.

 

 

현재 문서에 저장하고 싶으면 아래 그림처럼 현재 문서 내의 Microsoft Word 개체 폴더의 ThisDocument 에 붙여 넣기 한 후에 저장하시면 되고 워드 사용시 계속 위 코드를 사용하고 싶으시면 설정 파일인 Normal 의 Microsoft Word 개체 폴더의 ThisDocument 에 저장하시면 됩니다.

 

이제 Figure_Attributes() 함수에 대해 단축키를 지정해 볼까요.

 

워드 단축키 설정은 Word 옵션 à 사용자 지정 에 들어가서 설정 가능 합니다.



 


사용자 지정에서 다음과 같이 사용하고자 하는 단축키를 설정 합니다.

 

현재 위 코드는 워드VBATest 라는 문서에 저장되어 있어서 저장할 파일에 아래 그림처럼 선택한 것입니다. VBA 코드가 저장된 위치를 선택하시면 됩니다.

 

할당 상태를 보시면서 충돌 나지 않는 바로 가기 키로 만드시면 됩니다. 저는 아래 예에서 Alt+G 로 설정 했습니다.


 

이제 해당 문서에서 Alt+G 를 눌러보죠~ 아래 그림처럼 8cm 폭으로 동일하게 바뀐 것을 확인 할 수 있습니다. 굉장히 편리하죠~ ㅋㅋ

 

 

Reference:

 

http://www.techsupportforum.com/forums/f57/solved-a-resizing-image-macro-that-worked-in-word-2003-but-not-in-2007-a-510155.html 

 

http://stackoverflow.com/questions/1955886/visual-basic-macro-in-word-to-resize-center-delete-all-images 





2012-08-02 추가 내용 


위 Reference 를 읽다보니 답변 부분에 가운데 정렬에 대한 내용이 있더군요. 


크기 조절 하고 가운데 정렬 까지 하는 코드는 다음과 같습니다. 


빨간색으로 표시한 부분만 추가 된 겁니다.


Sub Figure_Attributes()


Dim oShp As Shape

Dim oILShp As InlineShape


For Each oShp In ActiveDocument.Shapes

    With oShp

        .Height = AspectHt(.Width, .Height, _

        CentimetersToPoints(12))          '원하는 숫자 입력 cm

        .Width = CentimetersToPoints(12)  '원하는 숫자 입력

    End With

    

    oShp.Select

    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

    

Next


For Each oILShp In ActiveDocument.InlineShapes

    With oILShp

        .Height = AspectHt(.Width, .Height, _

        CentimetersToPoints(12))            '원하는 숫자 입력

        .Width = CentimetersToPoints(12)    '원하는 숫자 입력

    End With

    

    oILShp.Select

    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

    

Next

End Sub



 

필요하신분이 계신것 같아서 코드 첨부합니다.

 

code.txt

 


<2012-12-17 일 추가 내용>


필요하신 분이 있는것 같아서 가로가 아닌 세로 폭 조절하는 코드 추가 합니다. AspectHt() 함수는 위에 첨부한 부분을 사용하시면 됩니다. 




Sub Figure_Attributes_Higth()


Dim oShp As Shape

Dim oILShp As InlineShape


For Each oShp In ActiveDocument.Shapes

    With oShp

        If (.Height > CentimetersToPoints(13)) Then

            .Width = AspectHt(.Height, .Width, _

            CentimetersToPoints(13))          '원하는 숫자 입력 cm

            .Height = CentimetersToPoints(13)  '원하는 숫자 입력

        End If

        

    End With

    

    oShp.Select

    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

    

Next


For Each oILShp In ActiveDocument.InlineShapes

    With oILShp

        If (.Height > CentimetersToPoints(13)) Then

            .Width = AspectHt(.Height, .Width, _

            CentimetersToPoints(13))            '원하는 숫자 입력

            .Height = CentimetersToPoints(13)    '원하는 숫자 입력

        End If

    End With

    

    oILShp.Select

    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

    

Next

End Sub



반응형

댓글