【Excel】直線オートシェイプの座標再設定【VBA】

【目的】

エクセルのシート上に配置済みの直線オートシェイプの座標を再設定するマクロ処理（VBA）で少し躓いたのでメモとして残す。ネットを検索しても、新規で直線オートシェイプを追加する方法は沢山見つかるのに、座標の再設定方法はあまり見つからないし。（少なくとも日本語圏では）

【基本的な考え方】

シート上に直線オートシェイプを追加するには以下のメソッドを利用する。
Shapes.AddConnector メソッド (Excel)
直線の始点、終点を指定する。

しかし、オートシェイプに保持される座標情報のプロパティは以下。

プロパティ名	意味
Left	オブジェクトの左端
Top	オブジェクトの上端
Width	オブジェクトの幅
Height	オブジェクトの高さ

つまり、直線に外接する矩形領域が保持される。

しかし、矩形領域情報だけでは、左右逆の場合と区別できない。
そこで反転プロパティもある。

プロパティ名	意味
HorizontalFlip	指定された図形が横軸で反転されている場合は True を指定します。 値の取得のみ可能な MsoTriState の値です。
VerticalFlip	指定された図形が縦軸で反転されている場合は True を指定します。 値の取得のみ可能な MsoTriState の値です。

ユーザプログラム上で直線を始点終点で管理している場合は、下記のように置き換えてプロパティに設定することになる。

プロパティ名	設定値
Left	始点X と 終点X の小さいほうの値
Top	始点Y と 終点Y の小さいほうの値
Width	始点X - 終点X の絶対値
Height	始点Y - 終点Y の絶対値
HorizontalFlip	始点X > 終点X の場合は True、それ以外は False
VerticalFlip	始点Y > 終点Y の場合は True、それ以外は False

HorizontalFlip、VerticalFlipプロパティが少々厄介。参照しかできない。
反転させたい場合はFlipメソッドをコールする。
Shape の Flip メソッド (Excel)

つまり、上記条件でTrue、Falseを決定しつつ、プロパティが既にその値ならスルー、違う場合はFlipメソッドをコールすることになる。
面倒なので、始点終点を指定したらガチャポンでプロパティを設定してくれる共通関数を用意しておくと良いだろう。

【実装例】

'------------------------------------------------------------------------------
' 機能:　　 直線オートシェイプの座標設定
' 引数:　   shapeName : オートシェイプ名称
'           startX : 始点X座標
'           startY : 始点Y座標
'           endX : 終点X座標
'           endY : 終点Y座標
' 返り値:　 True...正常終了, False...異常終了
' 機能説明: なし
' 備考:　　 なし
'------------------------------------------------------------------------------
Private Function SetLinePos(shapeName As String, startX As Single, startY As Single, endX As Single, endY As Single) As Boolean

On Error GoTo NO_OBJECT

    ' 指定されたオートシェイプの存在確認。存在しない場合は中断し、False を返す
    If IsObject(ActiveSheet.Shapes(shapeName)) Then
        SetLinePos = True
    End If
    
    ' 指定されたオートシェイプのプロパティ（座標情報）設定
    With ActiveSheet.Shapes(shapeName)
        .Left = Min(startX, endX)       ' オブジェクトの左端
        .Top = Min(startY, endY)        ' オブジェクトの上端
        .Width = Abs(startX - endX)     ' オブジェクトの幅
        .Height = Abs(startY - endY)    ' オブジェクトの高さ
        
        ' 必要に応じて左右反転
        If startX > endX <> .HorizontalFlip Then
            .Flip msoFlipHorizontal
        End If
        
        ' 必要に応じて上下反転
        If startY > endY <> .VerticalFlip Then
            .Flip msoFlipVertical
        End If
    End With
    
    Exit Function
    
NO_OBJECT:
    SetLinePos = False
    Err.Clear

End Function

'------------------------------------------------------------------------------
' 機能:　　 小さい方の値を返す
' 引数:　   a : 大小比較対象値
'           b : 大小比較対象値
' 返り値:　 小さい方の値
' 機能説明: なし
' 備考:　　 なし
'------------------------------------------------------------------------------
Private Function Min(a As Single, b As Single) As Single

    Min = IIf(a < b, a, b)

End Function

If文の個所が問題の反転プロパティを操作している個所。
前述のように説明するとややこしいが、実装してみると意外とシンプルにまとまるのが面白い。

【補足】

直線オートシェイプの始点や終点の移動操作をマクロの記録に保存してコードを確認すると、ScaleWidthやScaleHeightを使用している。オートシェイプの種類に依存せず一律に扱う仕様からくるコードと思われる。
Top等のプロパティを直接操作するのは実は悪手？