이것저것

엑셀 그림 셀에 맞추어 넣기 매크로

삽을벗삼아 2012. 6. 22. 11:31

Option Explicit
Sub fit_A_Picture_In_Selection()
    
    Dim rngSel As Range                             '선택영역 전체를 넣을 변수
    
    If TypeOf Selection Is Range Then           '선택한 것이 영영이라면
        MsgBox "그림이 선택되지 않음", 64, "영역선택 오류"  '경고 메시지 출력
        Exit Sub
    End If
 

    On Error Resume Next                            '에러 발생해도 다음 코드 진행
    Set rngSel = Application.InputBox("마우스로 복사될 위치를 선택하시오!", Type:=8)
    If rngSel Is Nothing Then Exit Sub            '취소 선택시 매크로 중단
    On Error GoTo 0                                    '에러검출기능 복원
        
    If rngSel.MergeCells Then                      'rngShp가 셀병합된 셀이라면
        Set rngSel = rngSel.MergeArea           '영역을 셀병합 영역으로 확장
    End If
        
    With Selection                                       '선택영역
        .ShapeRange.LockAspectRatio = msoFalse  '그림 좌우고정비율 해제
        .Left = rngSel.Left + 4                         '그림왼쪽위치를 셀의 왼쪽위 + 4
        .Top = rngSel.Top + 4                         '그림위쪽 위치를  셀의 왼쪽위 위치  +4
        .Height = rngSel.Height - 8                  '그림 높이를 현재셀 크기  - 8
        .Width = rngSel.Width - 8                     '그림 폭을 현재셀 크기 - 8
    End With
                    
    Set rngSel = Nothing                               '개체변수들 초기화(메모리 비우기)
    
    ActiveWindow.RangeSelection.Select       '영역을 선택
End Sub