컴퓨터/엑셀2018.06.21 14:40

Option Explicit

Sub fit_Picture_In_Cell()

    Dim rngAll As Range                                    '선택영역을 넣을 변수

    Dim rngShp As Range                                  '각 그림의 왼쪽위가 속한 영역을 넣을 변수

    Dim shpC As Shape                                    '각각의 도형(shape)을 넣을 변수

    Dim rotationDegree As Integer                       '도형의 회전각도 넣을 변수

    

    Application.ScreenUpdating = False              '화면 업데이트 (일시)정지

    

    If Not TypeOf Selection Is Range Then           '만일 그림 등을 선택하거나 하였을 경우

        MsgBox "영역이 선택되지 않음", 64, "영역선택 오류"  '경고 메시지 출력

        Exit Sub                                                 '매크로 중단

    End If

    

    Set rngAll = Selection                                  '선택영역을 변수에 넣음

    

    For Each shpC In ActiveSheet.Shapes          '전체영역내 각 그림을 순환

        If shpC.Type = 13 Then                            '만일 각 도형이 그림이라면

            Set rngShp = shpC.TopLeftCell             '각 도형의 왼쪽위 영역을 변수에 넣음

            

            If rngShp.MergeCells Then                   'rngShp가 셀병합된 셀이라면

                Set rngShp = rngShp.MergeArea       '영역을 셀병합 영역으로 확장

            End If

            

            If Not Intersect(rngAll, rngShp) Is Nothing Then '각 도형이 전체영역에 포함되면

                rotationDegree = shpC.Rotation         '그림의 회전각을 변수에 넣음

                

                If rotationDegree = 90 Or rotationDegree = 270 Then '그림이 90도 or 270도 회전된 경우

                

                    With shpC                                   '각 그림으로 작업

                        .LockAspectRatio = msoFalse   '그림 좌우고정비율 해제

                        .Rotation = 0                           '그림 회전을 원상태로 돌려 놓음

                        .Height = rngShp.Width - 4        '그림 높이를 현재셀 크기  - 4

                        .Width = rngShp.Height - 4        '그림 폭을 현재셀 크기 - 4

                        .Left = rngShp.Left + (rngShp.Width - shpC.Width) / 2

                                                                    '그림 폭 가운데 위치가 셀의 중앙에 오도록 정렬

                        .Top = rngShp.Top + (rngShp.Height - shpC.Height) / 2

                                                                    '그림위쪽 가운데 위치가 셀의 중앙에 오도록 정렬

                        .Rotation = rotationDegree        '그림 회전 각도를 복원

                    End With

                

                Else

                    With shpC                                  '각 그림으로 작업

                        .LockAspectRatio = msoFalse  '그림 좌우고정비율 해제

                        .Left = rngShp.Left + 2             '그림왼쪽위치를 셀의 왼쪽위 + 2

                        .Top = rngShp.Top + 2             '그림위쪽 위치를  셀의 왼쪽위 위치 + 2

                        .Height = rngShp.Height - 4      '그림 높이를 현재셀 크기  - 4

                        .Width = rngShp.Width - 4        '그림 폭을 현재셀 크기 - 4

                    End With

                End If

            End If

        End If

    Next shpC

    

    Set rngAll = Nothing                                      '개체변수 초기화(메모리 비우기)

End Sub

Posted by MinAngel