Help us understand the problem. What is going on with this article?

【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

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

つまり、上記条件でTrueFalseを決定しつつ、プロパティが既にその値ならスルー、違う場合は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文の個所が問題の反転プロパティを操作している個所。
前述のように説明するとややこしいが、実装してみると意外とシンプルにまとまるのが面白い。

【補足】

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

Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away
Comments
No comments
Sign up for free and join this conversation.
If you already have a Qiita account
Why do not you register as a user and use Qiita more conveniently?
You need to log in to use this function. Qiita can be used more conveniently after logging in.
You seem to be reading articles frequently this month. Qiita can be used more conveniently after logging in.
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away
ユーザーは見つかりませんでした