엑셀 도형( Shapes,그림,jpg )클릭 시 사진 확대 축소VBA 매크로 2가지

안녕하세요.

오늘은 사진이나 도형을

클릭했을 때 확대 축소 하는

엑셀 VBA 매크로를

소개 해 드립니다.

 

매크로 지정하고 사용하시면

좋습니다.

 

먼저 사진을 확대 축소하는

매크로 입니다.

 

사진은 축소 후 확대하면

이미지가 망가지기 때문에

엑셀에서 옵션을 조정 해야 합니다.

 

먼저 엑셀의 파일 - 옵션으로 갑니다.

고급을 선택 후

 

파일의 이미지 압축 안 함

 

체크 해 줍니다.

 

그리고 ALT+F11키를 눌러

 

매크로 에디터로 들어가서

모듈에서 아래의 매크로를 입력합니다.

( 이 매크로는 사진만 가능합니다. )

Sub PicZoom_click()
 
Dim shp As Shape
    Dim big As Single, small As Single
    Dim shpDouH As Double, shpDouOriH As Double
    big = 1
    small = 0.03125
    On Error Resume Next
    Set shp = ActiveSheet.Shapes(Application.Caller)
    With shp
        shpDouH = .Height
        .ScaleHeight 1, msoTrue, msoScaleFromTopLeft
        shpDouOriH = .Height
     
        If Round(shpDouH / shpDouOriH, 2) = big Then
            .ScaleHeight small, msoTrue, msoScaleFromTopLeft
            .ScaleWidth small, msoTrue, msoScaleFromTopLeft
            .ZOrder msoSendToBack
        Else
            .ScaleHeight big, msoTrue, msoScaleFromTopLeft
            .ScaleWidth big, msoTrue, msoScaleFromTopLeft
            .ZOrder msoBringToFront
        End If
    End With
End Sub
 

big =1

원본 크기 입니다.

 

small=0.03125

1/32배로 축소 하라는 의미 입니다.

 

사진을 한번 클릭하면 확대되고

 

다시 한번 더 클릭하면 축소 됩니다.

 

또한 저장 시 파일용량이 적어지지만

 

아래의 방법보다

 

로딩 속도가 좀 느립니다.

 

---

다음 매크로는

그림 및 도형, 객체, 쉐이프 모두 가능한

매크로 입니다.

 

 

Option Explicit 
 
Sub toggle_object_Zoom() 
 
    With ActiveSheet.Shapes(Application.Caller)              '매크로 실행한 도형 
        .LockAspectRatio = msoTrue                                '그림 가로세로 고정비율 설정
 
 
 
        If Right(.Name, 1) <> "#" Then                              '그림의 제일 마지막 문자가 "#"이면 
 
                .ScaleHeight 32, 0, msoScaleFromTopLeft        '왼쪽 윗지점 기준으로 그림을 32배 확대 
                .ZOrder msoBringToFront                             '그림을 제일 앞으로 가져옴 
                .Name = .Name & "#"                                   '그림 이름 뒤에 "#"을 추가함 
                 
        Else 
                .ScaleHeight 0.03125, 0, msoScaleFromTopLeft    '왼쪽 윗지점 기준으로 그림을 1/32로 축소 
                .ZOrder msoBringToFront                             '그림을 제일 앞으로 가져옴 
                .Name = Left(.Name, Len(.Name) - 1)             '그림 이름 제일 뒤의 "#"을 제거 
                 
        End If 
    End With 
End Sub
 
 

 

도형에서 채우기로 사진을 넣고

확대 축소 할경우 속도는 빠르지만

엑셀 파일 용량이 많이 늘어나네요. ㅠㅠ

 

 .ScaleHeight 32, 0, msoScaleFromTopLeft

32배로 확대 하라는 뜻

 

 .ScaleHeight 0.03125, 0, msoScaleFromTopLeft 

 

1/32로 축소하라는 뜻

 

---

 

다들 유용하게 잘 쓰시고

 

엑셀 부자 되세요~