October 7, 2011

MS Word Drawing Canvas Hack #3

This is a sequel of The topic about MS Word #1 and #2.

I’ve got a request for “Distribute Horizontally” and “Distribute Vertically”.
Then I wrote macros for them.

The code below.
Please refer previous entries about how to manage.

I’ve modified,,,

  • Added Function : DistributeHorizontal, DistributeAlignVertical, SortHorizontal, SortAlignVertical
  • Changed the type of variables : AlignHorizontal, AlignVertical

The algorithm for sorting was selected for its simplicity rather than speed since the number of objects to be distributed is not so large.

Private Sub AlignHorizontal(ARate As Single)
Dim Min, Max, i As Single
    Min = 32768
    Max = -32768
    For Each AShape In Selection.ChildShapeRange
        If Min > AShape.Left Then
            Min = AShape.Left
        End If
        i = AShape.Left + AShape.Width / 20
        If Max < i Then
            Max = i
        End If
    Next AShape
    For Each AShape In Selection.ChildShapeRange
        AShape.Left = Min * (1 - ARate) + Max * ARate - AShape.Width / 20 * ARate
    Next AShape
End Sub

Private Sub AlignVertical(ARate As Single)
Dim Min, Max, i As Single
    Min = 32768
    Max = -32768
    For Each AShape In Selection.ChildShapeRange
        If Min > AShape.Top Then
            Min = AShape.Top
        End If
        i = AShape.Top + AShape.Height / 20
        If Max < i Then
            Max = i
        End If
    Next AShape
    For Each AShape In Selection.ChildShapeRange
        AShape.Top = Min * (1 - ARate) + Max * ARate - AShape.Height / 20 * ARate
    Next AShape
End Sub

Private Sub AlignShape(AHorizontal As Boolean, ARate As Single)
    If Selection.ChildShapeRange.Count = 0 Then
        Exit Sub
    End If
    If AHorizontal Then
        AlignHorizontal (ARate)
    Else
        AlignVertical (ARate)
    End If
End Sub

Sub AlignHorizontalLeft()
    AlignShape True, 0
End Sub

Sub AlignHorizontalCenter()
    AlignShape True, 0.5
End Sub

Sub AlignHorizontalRight()
    AlignShape True, 1
End Sub

Sub AlignVerticalTop()
    AlignShape False, 0
End Sub

Sub AlignVerticalMiddle()
    AlignShape False, 0.5
End Sub

Sub AlignVerticalBottom()
    AlignShape False, 1
End Sub

Private Sub SortHorizontal(ByRef ACol As Collection)
Dim TmpCol    As Collection
Dim l_cls       As Object
Dim l_clsMin    As Object
Dim MinID As Integer
Dim i           As Integer
    Set TmpCol = New Collection
    Do Until (ACol.Count = 0)
        MinID = 1
        For i = 2 To ACol.Count
            If ACol(MinID).Left > ACol(i).Left Then
                MinID = i
            End If
        Next i
        TmpCol.Add ACol(MinID)
        ACol.Remove MinID
    Loop
    Set ACol = TmpCol
End Sub

Private Sub SortVertical(ByRef ACol As Collection)
Dim TmpCol    As Collection
Dim l_cls       As Object
Dim l_clsMin    As Object
Dim MinID As Integer
Dim i           As Integer
    Set TmpCol = New Collection
    Do Until (ACol.Count = 0)
        MinID = 1
        For i = 2 To ACol.Count
            If ACol(MinID).Top > ACol(i).Top Then
                MinID = i
            End If
        Next i
        TmpCol.Add ACol(MinID)
        ACol.Remove MinID
    Loop
    Set ACol = TmpCol
End Sub

Sub DistributeHorizontal()
Dim Min, Max, i, Total, Interval As Single
Dim ShapeCol As Collection
    If Selection.ChildShapeRange.Count > 1 Then
        Min = 32768
        Max = -32768
        Total = 0
        Set ShapeCol = New Collection
        For Each AShape In Selection.ChildShapeRange
            If Min > AShape.Left Then
                Min = AShape.Left
            End If
            i = AShape.Left + AShape.Width / 20
            If Max < i Then
                Max = i
            End If
            ShapeCol.Add AShape
            Total = Total + AShape.Width / 20
        Next AShape
        SortHorizontal ShapeCol
        Interval = (Max - Min - Total) / (ShapeCol.Count - 1)
        Total = ShapeCol(1).Left
        For Each AShape In ShapeCol
            AShape.Left = Total
            Total = Total + AShape.Width / 20 + Interval
        Next AShape
    End If
End Sub

Sub DistributeVertical()
Dim Min, Max, i, Total, Interval As Single
Dim ShapeCol As Collection
    If Selection.ChildShapeRange.Count > 1 Then
        Min = 32768
        Max = -32768
        Total = 0
        Set ShapeCol = New Collection
        For Each AShape In Selection.ChildShapeRange
            If Min > AShape.Top Then
                Min = AShape.Top
            End If
            i = AShape.Top + AShape.Height / 20
            If Max < i Then
                Max = i
            End If
            ShapeCol.Add AShape
            Total = Total + AShape.Height / 20
        Next AShape
        SortVertical ShapeCol
        Interval = (Max - Min - Total) / (ShapeCol.Count - 1)
        Total = ShapeCol(1).Top
        For Each AShape In ShapeCol
            AShape.Top = Total
            Total = Total + AShape.Height / 20 + Interval
        Next AShape
    End If
End Sub

comments

  1. Lotta :

    Just wanted to say thanks for this. It was driving me crazy how hard it was to get things aligned in the canvas, but this macro really worked great. Good job!

Comment for this post


Powered by WordPress, WP Theme designed by WSC Project.