나눔터  
  HOME > 나눔터 > 묻고답하기 > 엑셀
엑셀
엑셀에 대한 질문과 답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
 "000 님, 도와주세요", "부탁 드립니다.", "급합니다!" 등과 같이 막연한 제목을 달지 말아주세요.
[필독] 빠르고 정확한 답변을 얻는 16가지 Tip !
[필독] 저작권법 개정에 따른 이용안내

작성자:  

 티씨케이사랑 (rokmc925gi)

추천:  2
파일:     조회:  1532
제목:   사진 다수 선택 후 자르기 매크로 문의
     
  * 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.

 - 엑셀 버전(2017):

* 아래줄에 질문을 작성하세요 >>

해당 매크로는 사진을 하나 선택후 사진 자르기 가능함.

사진을 다수를 선택하여 사진 자르기 매크로로 변경하려 합니다. 

변경 방법 아시는분 확인좀 부탁드립니다. 


Sub crop_Picture_Frame()

    Dim obj As Object                                           '선택한 개체를 넣을 개체 변수
    Dim sngLeft As Single                                     '사진의 왼쪽 위치 넣을 변수
    Dim sngTop As Single                                     '사진의 윗쪽 위치 넣을 변수
    Dim sngWidth As Single                                  '사진의 폭을 넣을 변수
    Dim sngHeight As Single                                 '사진의 높이를 넣을 변수
    Dim intCrop As Integer                                     '사진의 crop 되는 정도를 넣을 변수
    Dim raiseW As Single                                      '사진의 너비 키울 변수
    Dim raiseH As Single                                        '사진의 높이 키울 변수
    
    Application.ScreenUpdating = False                '화면 업데이트 (일시) 정지
    
    Set obj = Selection                                           '선택한 것을 개체 변수에 넣음
    
    
    
    ''===사진을 다수 선택할수 있는 변수및 수식 좀 알려주세요====
    
    intCrop = 1                                                        '테두리 잘려나갈 크기는 기본으로 1 넣음
    
    If TypeName(obj) <> "Picture" Then                 '선택한 것이 사진이 아니라면
        MsgBox "사진을 선택 후 재실행 하시오.", vbExclamation  '메시지 출력
        Exit Sub                                                         '매크로 중단
    End If
    
    With Selection                                                   '선택한 것과 함께
        raiseW = (.Width * 1 / 100) / 2                      '사진 너비를 1/100 배 나누기 2 (증가시키려 함)
        raiseH = (.Height * 1 / 100) / 2                       '사진 높이를 1/100배 나누기 2 (증가시키려 함)
    
        With .ShapeRange                                        '사진의 범위
            .LockAspectRatio = msoFalse                  '좌우 고정비율을 해제
            .IncrementLeft raiseW                               '사진 왼쪽 위치 늘림
            .IncrementTop raiseH                                '사진 윗쪽 위치 늘림
            .ScaleWidth 0.99, 0, 0                                '사진의 너비 스케일을 0.01% 낮춤
            .ScaleHeight 0.99, 0, 0                               '사진의 높이 스케일을 0.01% 낮춤
                
            With .PictureFormat.Crop                          '사진포맷의 crop
                .PictureWidth = .PictureWidth + intCrop  '지정한 크기 만큼 너비 늘림
                .PictureHeight = .PictureHeight + intCrop '지정한 크기 만큼 높이 늘림
'                .PictureOffsetX = 0
'                .PictureOffsetY = 0
            End With
        End With
    End With

    Set obj = Nothing                                                   '개체변수 초기화(메모리 비우기)
End Sub
 
[불량 게시물 신고]  
        
  

작성일 : 2021-01-18(18:44)
최종수정일 : 2021-01-18(18:44)