사진을 여러 칸(박스)로 자동으로 분할하기

 

사진을 선택하고 Alt-F8을 눌러 Picture2Boxes 매크로를 실행하고 "3,3"을 입력합니다.

이미치 출처: https://freepik.com

 

아래처럼 그림이 3* 3개의 작은 박스 그림으로 분할됩니다.

이미지 자르기 기능으로 여러개의 작은 박스로 분할하는 작업을

자동으로 정확하게 처리할 수 있습니다.

 

참고: 지식인

 

 

PictureFormat.CropLeft/Right/Top/Bottom 을 이용합니다.

​

Alt-F11 창에서 삽입 > 모듈 추가한 후 아래 코드를 붙여 넣습니다.

코드창을 닫고 원하는 사진을 선택하고 Alt-F8로 실행하면 됩니다.

 

Option Explicit
 
'when a box is clicked
Sub Click_Box(boxShp As Shape)
    
    boxShp.Visible = msoFalse
    
End Sub
 

Sub Picture2Boxes()

    Dim shp As Shape, sld As Slide
    Dim n As Integer, r As Integer, c As Integer, Rs As Integer, Cs As Integer
    Dim cw!, ch!, w!, h!, x!, y!, cWidth!, cHeight!, oWidth!, oHeight!, cLeft!, cTop!
    Dim user As String, RowCol() As String
    
    On Error Resume Next
    Set shp = ActiveWindow.Selection.ShapeRange(1)
    On Error GoTo 0
    If shp Is Nothing Then MsgBox "Select a picture first": Exit Sub
    
    Set sld = shp.Parent
    
    '가로, 세로 개수    'Rs = 10:        Cs = 10
    user = InputBox("선택한 이미지를 지정한 가로*세로 개수로 작게 분할(크롭)합니다." & vbNewLine & vbNewLine & _
        "가로와 세로 칸수를 콤마(,)로 구분해서 입력하세요:" & vbNewLine & _
        "(예: 5, 4 =>가로5칸*세로4칸 총 20개로 분할 생성)", "이미지 분할", "5, 4")
    If Len(user) = 0 Then Exit Sub
    
    RowCol = Split(user, ",")
    
    If UBound(RowCol) <> 1 Then MsgBox "콤마로 구분된 숫자 2개가 아닙니다.": Exit Sub
    If Not IsNumeric(RowCol(0)) Or Not IsNumeric(RowCol(1)) Then MsgBox "숫자로 입력하세요.": Exit Sub
        
    Cs = CInt(RowCol(0)): Rs = CInt(RowCol(1))
    
    '현재 크기와 위치
    cWidth = shp.Width:     cHeight = shp.Height
    cLeft = shp.Left:       cTop = shp.Top
    
    '원본 크기를 구함
    shp.ScaleWidth 1, msoTrue
    shp.ScaleHeight 1, msoTrue
    oWidth = shp.Width:         oHeight = shp.Height
    
    '처음 크기로 복구
    shp.Width = cWidth:         shp.Height = cHeight
    
    shp.Copy: DoEvents: shp.Visible = msoFalse
 
    '박스 크기 계산
    w = oWidth / Cs:     h = oHeight / Rs
    cw = cWidth / Cs:    ch = cHeight / Rs
    
    '가로*세로 개수만큼 순환
    For r = 1 To Rs
        For c = 1 To Cs
        
            n = n + 1
            x = cLeft + (c - 1) * cw
            y = cTop + (r - 1) * ch
 
            With sld.Shapes.Paste(1)
                DoEvents
                .Name = "Box_" & Format(n, "00")
                .ScaleWidth 1, msoTrue
                .ScaleHeight 1, msoTrue
                
                '크롭
                .PictureFormat.CropLeft = oWidth * (c - 1) / Cs
                .PictureFormat.CropRight = oWidth * (Cs - c) / Cs
                .PictureFormat.CropTop = oHeight * (r - 1) / Rs
                .PictureFormat.CropBottom = oHeight * (Rs - r) / Rs
                
                .LockAspectRatio = msoFalse '비율 유지 안함
                .Width = cw
                .Height = ch
                .Left = x
                .Top = y
                .Line.Weight = 0.1
                
                '박스 클릭시 실행할 매크로 지정
                '.ActionSettings(ppMouseClick).Action = ppActionRunMacro
                '.ActionSettings(ppMouseClick).Run = "Click_Box"
            End With
     
        Next c
    Next r
    
End Sub

Sub RemoveBoxes()

    Dim sld As Slide, l As Long
    
    Set sld = ActiveWindow.Selection.SlideRange(1)
    
    With sld.Shapes
        For l = .count To 1 Step -1
            If .Item(l).Name Like "Box_*" Then .Item(l).Delete
        Next l
    End With

End Sub

 

 

사진을 선택하고 Alt+f8을 누르면 매크로 목록이 뜹니다. Picture2Boxes 를 실행합니다.

​

가로와 세로 개수를 10개씩 즉 10, 10을 입력합니다.

 

실행 결과, 아래처럼 100개의 조각으로 쪼개집니다.

원래 ​Crop 작업은 100% 사이즈로 처리해야 하는데

이미지의 원본사이즈보다 늘어나거나 줄어든 경우도 반영하였습니다.

 

가로, 세로 개수는 "5, 4" 혹은 "7, 4"와 같은 식으로 입력하면 지정한 개수대로 생성이 됩니다.

​

10,10인 경우 100개의 도형이 생겨버리면 실행이나 애니메이션을 각각 지정하는 것도 힘든데

VBA를 이용하면 일괄로 지정할 수도 있습니다.

​

​

샘플 파일 참고하세요.

​

​

참고로 그림을 조각으로 나눠서 슬라이딩 퍼즐을 만들수 있습니다.

https://cafe.naver.com/gameppt/133389

[퍼즐러, the PuzzleR] 슬라이딩 퍼즐(그림맞추기) Beta 출시

 

 

여러개의 박스 뒤에 숨은 그림을 찾는 퍼즐도 만들 수 있습니다.

https://konahn.tistory.com/entry/Hidden-Picture

Hidden Picture

 

 

 

샘플 파일:

Pictue2Boxes1.pptm

5.11MB