엑셀 그림 클릭 확대 축소 VBA 매크로 완성형- 축소 시 셀 맞춤까지 완벽(EXCEL picture shapes, zoom, reduction,Cell alignment)

 

엑셀 사진 클릭 확대 축소

VBA 매크로 완성형

- 축소 시 셀 맞춤까지 완벽 
(EXCEL picture shapes, zoom, reduction,Cell alignment)

 

 

이번에 소개 해 드릴 엑셀 VBA코드는

 

도형, 사진 관계없이

 

확대/축소 되고

 

축소 시

 

셀크기에 맞춰

 

축소 되는 매크로 입니다.

Sub ToggleZoomImage()
    Dim shp         As Shape
    Dim rngTarget   As Range
 
    On Error GoTo Err_Trap   '오류 발생시 object 변수들을 초기화 하고 종료
 
    Set shp = ActiveSheet.Shapes(Application.Caller)  '마우스로 크릭한 도형을 shp 라는 shape 변수에 저장
 
    If shp.Type = 1 Or shp.Type = 13 Or shp.Type = 11 Then   '클릭한 도형,그림,삽입 사진, 연결 삽입 된 사진이라면
        Set rngTarget = shp.TopLeftCell.MergeArea    'rngTarget변수에 도형의 좌측모서리 위치의 셀을 저장
        If rngTarget.Width = shp.Width And rngTarget.Height = shp.Height Then  '병합된 셀의 크기와 사진의 크기가 같으면
            With shp
                .Height = rngTarget.Height * 25 '너비의 25배
                .Width = rngTarget.Width * 20   '높이의 20배
                .ZOrder msoBringToFront        '그림을 맨 앞으로
            End With
        Else
            With shp
                .LockAspectRatio = msoFalse  '가로세로비율고정을 해제
                .Height = rngTarget.Height '지정된 셀의 높이에 그림의높이를 맞춤
                .Width = rngTarget.Width   '지정된 셀의 너비에 사진 너비 조정
                .Left = rngTarget.Left      '지정한 셀의 좌측에 사진 맞춤
                .Top = rngTarget.Top        '지정한 셀의 높이에 사진 높이를 맞춤
            End With
        End If
    End If
 
Err_Trap:
    Set shp = Nothing   'Shape 변수 초기화
    Set rngTarget = Nothing         'Range 변수 초기화
End Sub
 

---

그림 사진 도형

 

확대 축소 끝판 매크로 입니다.

 

모두 주말 잘

 

보내시고

 

코로나 조심 하세요.