사진삽입 소스

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

Sub ToggleZoomImage1()    '사진삽입셀에 정확하게 그리고 줌 확대(2022년 10월 18일 골드벨스타)
    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 - 2 * 3 '너비의 3배
                .Width = rngTarget.Width - 2 * 2 '높이의 2배
                .ZOrder msoBringToFront        '그림을 맨 앞으로
            End With
        Else
            With shp
                .LockAspectRatio = msoFalse  '가로세로비율고정을 해제
                .Height = Selection.Height - 4  '  .Height = rngTarget.Height '지정된 셀의 높이에 그림의높이를 맞춤
                .Width = Selection.Width - 4     '  .Width = rngTarget.Width   '지정된 셀의 너비에 사진 너비 조정
                .Left = Selection.Left + 2       '  .Left = rngTarget.Left      '지정한 셀의 좌측에 사진 맞춤
                .Top = Selection.Top + 2         '  .Top = rngTarget.Top        '지정한 셀의 높이에 사진 높이를 맞춤
            End With
        End If
    End If
 
Err_Trap:
    Set shp = Nothing   'Shape 변수 초기화
    Set rngTarget = Nothing         'Range 변수 초기화
    
End Sub