Sctipt-shape #

Sub shapealign_bottom()
    Dim standardshape As shape
    Dim shapeName() As String
    Dim shapenameOrigin() As String
    Dim selectShapes As ShapeRange
    Dim arrcount As Integer
    Dim x As Integer
    Dim y As Integer
    Dim culumheight As Single
    Dim standardshape_height As Single
    Dim standardshape_width As Single
    Dim standardshape_left As Single
    Dim standardshape_top As Single

    On Error GoTo Err_Check ' 에러 발생 시 Err_Check로 이동
    
    If ActiveWindow.Selection.Type = ppSelectionShapes Then
        Set selectShapes = ActiveWindow.Selection.ShapeRange
        
        'selected shape name array
        ReDim Preserve shapeName(selectShapes.Count)
        ReDim Preserve shapenameOrigin(selectShapes.Count)
        
        'selected shape name array count
        arrcount = UBound(shapeName) - LBound(shapeName)
        
        For x = 1 To arrcount
            shapenameOrigin(x) = selectShapes(x).Name
            selectShapes(x).Name = selectShapes(x).Name & x
        Next x
        
        For Each shp In selectShapes
            For x = 1 To arrcount
                If shapeName(x) = "" Then
                    shapeName(x) = shp.Name
                    Exit For
                End If
            Next x
        Next shp
    Else
        MsgBox "There is no shape currently selected!", vbExclamation, "No Shape Found"
        Exit Sub
    End If

    ' Ensure there is at least one shape to align
    If arrcount < 1 Then
        MsgBox "No shapes were selected for alignment!", vbExclamation
        Exit Sub
    End If

    ' Get standard shape dimensions and position
    standardshape_height = ActiveWindow.Selection.ShapeRange(shapeName(1)).height
    standardshape_width = ActiveWindow.Selection.ShapeRange(shapeName(1)).width
    standardshape_left = ActiveWindow.Selection.ShapeRange(shapeName(1)).left
    standardshape_top = ActiveWindow.Selection.ShapeRange(shapeName(1)).top

    For y = 2 To arrcount
        ActiveWindow.Selection.ShapeRange(shapeName(y)).top = standardshape_top + standardshape_height
        
        If y > 2 Then
            culumheight = culumheight + ActiveWindow.Selection.ShapeRange(shapeName(y - 1)).height
            ActiveWindow.Selection.ShapeRange(shapeName(y)).top = ActiveWindow.Selection.ShapeRange(shapeName(y)).top + culumheight
        End If
        
        ActiveWindow.Selection.ShapeRange(shapeName(y)).left = standardshape_left
    Next y

    For x = 1 To arrcount
        selectShapes(x).Name = shapenameOrigin(x)
    Next x

    Exit Sub
    
Err_Check:
    If Err.Number <> 0 Then
        MsgBox "오류번호 : " & Err.Number & vbCr & "오류내용 : " & Err.Description, vbCritical, "오류 발생"
    End If
    Exit Sub
End Sub

Sub shapealign_right()
    Dim selectedShape As shape
    Dim secondShape As shape
    Dim shapeLeftInPoints As Single
    Dim shapeWidthInPoints As Single
    Dim sel As Selection
    Dim i As Integer
    
    On Error GoTo Err_Check ' 에러 발생 시 Err_Check로 이동

    Set sel = ActiveWindow.Selection

    If sel.Type = ppSelectionShapes Then
        If sel.ShapeRange.Count >= 2 Then
            Set selectedShape = sel.ShapeRange(1)
            For i = 2 To sel.ShapeRange.Count
                Set secondShape = sel.ShapeRange(i)
                shapeLeftInPoints = selectedShape.left
                shapeWidthInPoints = selectedShape.width
                secondShape.left = shapeLeftInPoints + shapeWidthInPoints
            Next i
        Else
            MsgBox "Please select over 2 shapes", vbExclamation
        End If
    Else
        MsgBox "Please select shapes.", vbExclamation
    End If

    Exit Sub
    
Err_Check:
    If Err.Number <> 0 Then
        MsgBox "오류번호 : " & Err.Number & vbCr & "오류내용 : " & Err.Description, vbCritical, "오류 발생"
    End If
    Exit Sub
End Sub