直線シェイプを回転させる

ラボ

はじめに

 直線図形(シェイプ)を手動で回転させるには、直線を選択して、片方のポイントを移動する事で簡単にできます。ただ、これをVBAで制御したい場合は、少々厄介です。

※シェイプの位置を読み込んだり設定したりするツールを作ってみました。以下のページを参照してください。
シェイプの位置を正確に合わせる

VBAでシェイプの位置を変更する

 VBAでシェイプの位置を変更するには、直線シェイプに限らず、 Left , Top , Width , Height の4つのプロパティを変更することになります。つまり、左上のポイントと、幅、高さを指定します。

 直線シェイプの場合でも、左上のポイントと、幅、高さという矩形で位置を設定するのですが、この値のみに頼ると、以下のように思ったような結果にならない事があります。

直線シェイプには Flip 属性に注意する

 シェイプには、 Left , Top , Width , Height の4つのプロパティの他に、上下、左右の向きを反転させる Flip という属性があります。直線シェイプを回転させたいような時は、反転属性に注目しなければいけません。

 尚、反転属性は、読み込み専用のプロパティ、.HorizontalFlip(左右反転)と .VerticalFlip(上下反転)の2つで判定できます。設定する場合は、.Flip メソッドに引数を付けて実行します。

.Flip msoFlipHorizontal (左右反転)
.Flip msoFlipVertical (上下反転)

 反転のプロパティはブール型(FALSE/TRUE)で、FALSEの場合は反転していません。.Flip メソッドは実行すると現在の値を反転させます。

テストプログラムで動作を確認

 直線シェイプを回転させた時そのような挙動となるかは以下のようなプログラムを書いて試してみればわかります。

Sub ボタン1_Click()
    With ActiveSheet.Shapes(1)
        Range("K3") = .Left
        Range("K4") = .Top
        Range("K5") = .Width
        Range("K6") = .Height
        
        If .HorizontalFlip Then
            Range("K8") = "True"
        Else
            Range("K8") = "False"
        End If
        
        If .VerticalFlip Then
            Range("K9") = "True"
        Else
            Range("K9") = "False"
        End If
        
    End With
    
End Sub

 座標の十字は、セルの罫線です。直線シェイプでなく矢印のシェイプにしているのは、始点と終点がわかりやすいようにしています。

 使い方は、シェイプを選択して、矢印側のポイントを移動させて「値を設定」ボタンを押します。
それぞれのプロパティ値がセルに表示されます。シェイプの傾きによって反転属性が変化しているのが判ると思います。

シェイプの反転

 シェイプの反転については以下のように変化するのが判ります。

 尚、新しく直線シェイプを作成する際には、AddConnector メソッドを使いますが、引数は始点、終点で指定しています。

ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 始点左, 始点上, 終点左, 終点上)

 当然ですが、ここでは反転属性も適切に設定されています。直線シェイプを移動する際も始点と終点で指定できるようにプログラムを書いてみましょう。

直線シェイプを始点・終点で移動できるプログラム

 直線シェイプを始点と終点でしていして移動できるプログラムです。
引数には、シェイプ名と、始点左、始点上、終点左、終点上を指定します。シェイプ名は、シェイプを選択した状態で、Excel画面左上の名前ボックスを確認してください。

 冒頭でエラー処理を行っています。シェイプ名が違っていた場合、また、シェイプ名が空白の場合はエラーとなるので、処理を抜けるようにしています。

  Left , Top の値は始点、終点の小さい方の値を取るようにします。また、Width , Heightに関しては始点、終点を引き算して絶対値を取ります。

 最後に反転処理です。始点、終点の左、上の大きさから反転するかどうかを判断しています。

Sub setMyConnector(sName As String, stLeft As Single, stTop As Single, eLeft As Single, eTop As Single)
    
    If IsObject(ActiveSheet.Shapes(sName)) = False Or sName = "" Then
        Debug.Print "オブジェクトがありません。"
        Exit Sub
    End If
    
    With ActiveSheet.Shapes(sName)
   
        .Left = IIf(stLeft < eLeft, stLeft, eLeft)
        .Top = IIf(stTop < eTop, stTop, eTop)
        .Width = Abs(stLeft - eLeft)
        .Height = Abs(stTop - eTop)
                      
        If stLeft > eLeft Then
            If Not .HorizontalFlip Then .Flip msoFlipHorizontal
        Else
            If .HorizontalFlip Then .Flip msoFlipHorizontal
        End If
        
        If stTop > eTop Then
            If Not .VerticalFlip Then .Flip msoFlipVertical
        Else
            If .VerticalFlip Then .Flip msoFlipVertical
        End If
        
    End With
End Sub

回転角度で制御したい時

 上記の方法では、直線シェイプの終点を計算で求めないと回転しているようには見えません。そこで直線シェイプを回転角度で制御したい場合のアイデアも紹介しましょう。
単に直線シェイプを回転させたい場合、.Rotationプロパティ値を変えれば回転はできますが、シェイプの中心で回転してしまうため、始点から回転させる事ができません。

 そこで以下のように直線シェイプを2つ重ねて片方を「枠線なし」に設定して、グループ化すれば、シェイプ全体の中心は片方のシェイプの始点となります。

 左側のシェイプは、少し色を付けて分かりやすくしています。実際には「枠線なし」で透明にします。
2つのシェイプは同じ長さにしておきます。

 グループ化したシェイプ名は、Excel画面左上の名前ボックスで確認できます。

Sub testConnectorRotation()
    With ActiveSheet.Shapes("グループ化 6")
        .Rotation = .Rotation + 45
        Debug.Print .Rotation
    End With
End Sub

 実行すると、右回りに45度づつ回転していきます。一周すると角度は0度に戻ります。

コメント

タイトルとURLをコピーしました