どっっっぷりIT系の話しアゲイン。
先日のMicrosoft Wordの描画キャンバスの話しとその続編のさらに続きです。
英語のブログの方に『「左右に整列」と「上下に整列」もできるようにしてくれない？』っていうコメントと言うかリクエストが来たのでやってみた、って話。
マクロを追加しただけなのでやり方は以前の記事を参照して下さいませ。
変更点は以下のとおり。
・関数を追加(DistributeHorizontal,DistributeAlignVertical,SortHorizontal,SortAlignVertical)
・以前の関数内の変数の型を修正(AlignHorizontal,AlignVertical)
整列させたいモノはそんなに多くないという前提で、速さよりも簡潔さを重視したソートアルゴリズムにしています。
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
