ねずみやブログ～ねずブロ～ Nezumiya's Blog 四十八茶百鼠

どっっっぷり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

（その3を書きました（2011.10.7））

描画キャンバスの使いにくい特徴の対策については昨日書いた通り。

でもって、そのマクロの機能を毎回「開発」のリボンから呼び出すのもかったるいので、そいつらはよく使うリボンに登録しちゃいましょ、の話し。

まず、Wordのオプションを開く。それから、、、

1. リボンのユーザ設定を選択
2. 「コマンドの選択」で「マクロ」を選択
3. 「リボンのユーザ設定」で「ツールのタブ」を開いてから「描画ツール→書式→配置」を選択

1. 新しいグループを作って
2. マクロを追加して
3. 名前を適宜変更する

これでリボンにボタンを登録できた。

めでたしめでたし。
不要ならこれで開発リボンは非表示にしてもOKです。

（その2とその3もあります（2011.10.7））

どっぷりIT系のお話。

技術系の話題に興味がない方はスルーで。
でもMicrosoft Word 2010を使っていて描画キャンバス関連で悩みがある人は読むともしかして解決するものがあるかも。。。
あくまでも「かも」。

同じ大学で教えていて縁のある高橋信夫先生のブログでWord 2010の仕様なのか不具合なのかわからないけど不都合がある特徴についての記事を読んだ。

恥ずかしながらこの特徴について問題意識はなく、今までじっくり考えたことがなかったので、これを機に検証したりしてみた。
結果、最も具合が悪くかつスマートな回避策がなさそうなのが
描画キャンバスの中では配置関連の機能が使えない
という点。

描画キャンバスと配置機能

一旦気づいてしまうとどうしても気になってしまうもので、解決策を考えた。
マクロを登録しちゃいましょうって方向で。
まぁその時点で若干ハードルは高いけど以下の手順通りやれば問題ないはず。
あくまでも「はず」。

何かあっても責任は取れませんので、あくまでも自己責任でよろしくです。

まずは、マクロが使えるように「ファイル」メニューの「オプション」で「開発」というリボンを表示させる。

Wordのオプションで開発リボンを表示

表示されるようになった「開発」のリボンから「Visual Basic」を開く。
で、「Normal」を右クリックして標準モジュールを追加する。

標準モジュールの追加

で、標準モジュールの中にできた「Module1」に以下のコードをコピペ。

Private Sub AlignHorizontal(ARate As Single)
Dim Min, Max, i As Integer
    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 Integer
    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

で、Visual Basicの窓は保存したら閉じてOK。

もうこれで使えるようになった。
描画キャンバスの中身のうち配置を調整したいもの（図形でもクリップアートでも）を複数選んでから「開発」リボンにある「マクロ」ボタンをクリック。
6つのAlign関連のマクロが登録されているはずなので、それを使用。
あとはマクロの名前から動作は察してください。

（2011年8月4日追記：いちいちマクロを呼び出すのは面倒なのでこれらをリボンに登録する話を書きました。）

描画キャンバス外の要素には効果がないようですが、描画キャンバス外ならそもそも正規の配置機能が使えるのでそちらを。
ほぼテストコードなので「利用は各自の責任で」というお約束の記述も一応。
このコード程度の規模で著作権どうこうなんて言うつもりもないので利用・改変はご自由に♪
転載するときなどはこの元記事にリンクとかあると嬉しいな、くらいの感じです。

「そのコードじゃ美しくないぜ」などご意見等はコメント欄まで。
「動きません・・・」系の質問などもコメント欄にどうぞ、ではありますが、サポートしきれない可能性が高いので予めご了承を。