Excel シェイプの矢印を試作 Shapes AddConnectorで矢印を作成

Excelシェイプで矢印を作成してスクショの場所を指してみた。
不具合付きの自己満足ですがヨロシクお願いします。
https://www.youtube.com/watch?v=Rnji4U4BI7k
目次
00:00 あいさつ 1.キッカケと実行結果を先に見せる
05:00 1.1 問題点単純に左上の座標にセットしているので、わかりにくい
10:13 2.1 シェイプの線を引くには？マクロ記録のコードを修正して確認テスト
11:51 2.2 セルの左上は？簡単で単純にRangeのLeftとTopでした
17:07 3.PowerPointスクショもどきに線を引く
25:14 3.1 スケール調整って何？ Const スケール調整 = (480 / 960)
32:25 4.おわりの挨拶はやく会計して終わらせてよ・・・

1.キッカケと実行結果を先に見せる
https://www.youtube.com/watch?v=Rnji4U4BI7k
↑実行結果を先に見せる。

手前味噌1:前回のPowerPointの①スクショもどき②シェイプの一覧
ken3memo.hatenablog.com
https://www.youtube.com/watch?v=XIBG8T3b2mY
↑
この処理・表示に追加アレンジ、調子に乗って
③シェイプ情報のTop,Leftを使用して、スクショもどきに矢印で位置をわかりやすくしてみた

1.1 問題点単純に左上の座標にセットしているので、わかりにくい
自己満足な一品なので、左上の座標(left,top)に単純にセットしているので、
ア.テキストボックス,円,大きな四角形などは、位置が逆にわかりにくい？
イ.直線や線などは、始点がピッタリなので、わかりやすかったりするけど・・・
ウ.↑で、始点の話をしたけど、下からひっぱったら？線を回転させたら？
改善点:
テキストボックスや円などは、中心を指すように変更した方がよい？
※↑を行うと、直線が？変になる？わりきって使う？

手前味噌2:VBSを使用してExcel選択範囲のセルをPowerPointへ１つ１つ分解セット
ken3memo.hatenablog.com
https://www.youtube.com/watch?v=1FNXLH_re6k&t=548s
↑
意外と使えるので、使ってみてね。と手前味噌の宣伝を入れつつ、

2.Excel VBA 線を引く矢印を作るには？

時間が無いんだ、中身の説明をハヤクしてください。

2.1 シェイプの線を引くには？
https://www.youtube.com/watch?v=Rnji4U4BI7k&t=613
マクロ記録で記録してコードを調べました
いつものように、マクロ記録でコードを調べました。

Sub Macro1()

    ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 210.75, 86.25, 419.25, _
        176.25).Select
        Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadTriangle
        Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .Weight = 4.5
    End With
    Range("H2").Select
End Sub

Shapes.AddConnectorで線を引けることがわかりました。
あと、矢印の形は、
Line.BeginArrowheadStyle = msoArrowheadTriangle
Line.EndArrowheadStyle = msoArrowheadTriangle
幅は、
ShapeRange.Line.Weight = 4.5
なので、ヘルプやググって、詳細をチェックしてください。

2.2 セルの左上は？簡単で単純にRangeのLeftとTopでした

次は、セルの位置ですが、単純に
RangeのLeftとTopでした。

テストしてみます。

Sub Macro1_240318_セルに線を引く01()

    Dim r1 As Range: Set r1 = Range("A1")
    Dim r2 As Range: Set r2 = Range("G3")

    Dim shpArrow As Shape  '矢印もシェイプの一部です

    '矢印の作成 単純にセルの左上の座標を指定してみた
    Set shpArrow = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, _
                                      r1.Left, r1.Top, r2.Left, r2.Top)
                                      
    With shpArrow.Line  '線のパラメーターをセットする、形を変える
        .BeginArrowheadStyle = msoArrowheadTriangle '開始の形
        .EndArrowheadStyle = msoArrowheadTriangle   '終了の形
        .Visible = msoTrue
        .Weight = 4.5  '幅
    End With
    
    MsgBox "追加完了、確認してね"

End Sub

セルの中央に線を引く

Sub Macro1_240318_セルに線を引く02中心にしてみた()

    Dim r1 As Range: Set r1 = Range("A1")
    Dim r2 As Range: Set r2 = Range("G3")

    Dim shpArrow As Shape  '矢印もシェイプの一部です

    '矢印の作成 中心にしたかったので、
    '単純にセルの左上の座標に幅÷2と高さ÷2をプラスして調整してみた
    Set shpArrow = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, _
                                      r1.Left + (r1.Width / 2), _
                                      r1.Top + (r1.Height / 2), _
                                      r2.Left + (r2.Width / 2), _
                                      r2.Top + (r2.Height / 2))
                                      
    With shpArrow.Line  '線のパラメーターをセットする、形を変える
        .BeginArrowheadStyle = msoArrowheadTriangle '開始の形
        .EndArrowheadStyle = msoArrowheadTriangle   '終了の形
        .Visible = msoTrue
        .Weight = 4.5  '幅
    End With
    
    MsgBox "追加完了、確認してね"

End Sub

3.PowerPointスクショもどきに線を引く

やっと確認の単体テストが終了したので、
テストした単体部品(素材)を使って、
https://www.youtube.com/watch?v=Rnji4U4BI7k&t=1027
↑作成してみます。

'Excel矢印を作成して、場所を指す
'セルの位置から矢印を画像に引く
Sub test240318_01スクショもどきに矢印を引く()

    Const スケール調整 = (480 / 960)  'スクショもどきと現物を調整する

    Dim shpArrow As Shape  '矢印にする
    
    Dim rBASE As Range
    Set rBASE = Range("B1")
    
    Dim y As Integer
    
    Dim Start_X As Double, Start_Y As Double
    Dim End_X As Double, End_Y As Double
    
    For y = 1 To 999  'いつものとりあえず999まで回す
        If Trim("" & rBASE.Offset(y, 0)) = "" Then Exit For 'データ無しなら抜ける
    
        Start_X = rBASE.Offset(y, 4) * スケール調整 'ppのLeft
        Start_Y = rBASE.Offset(y, 5) * スケール調整 'ppのTop
        
        End_X = rBASE.Offset(y, 2).Left  '3列目セルのLeft 0から始まるので2を指定
        End_Y = rBASE.Offset(y, 2).Top + (rBASE.Offset(y, 2).Height / 2) 'セルのTop + Height÷2
    
        '矢印の作成
        Set shpArrow = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, Start_X, Start_Y, End_X, End_Y)
        shpArrow.Name = "矢印" & y  '名前を変更、後で消しやすいように
        With shpArrow.Line  '線のパラメーターをセットする、形を変える
            .BeginArrowheadStyle = msoArrowheadTriangle '開始の形
            .EndArrowheadStyle = msoArrowheadTriangle   '終了の形
            .Visible = msoTrue
            .Weight = 4.5  '幅
        End With

    Next
    
End Sub

3.1 スケール調整って何？ Const スケール調整 = (480 / 960)

突然出てきた、
https://www.youtube.com/watch?v=Rnji4U4BI7k&t=1514
Const スケール調整 = (480 / 960) ↑って何？

スクショを前回作成のコードで落とした後、シートへ貼り付けます
ここで、

' 画像を0,0へ 埋め込み形式で挿入 ファイル名,リンク,保存保持,left,top,Width,Height
Set picShape = shNEW.Shapes.AddPicture(strJPGNAME, False, True, 0, 0, -1, -1)
picShape.Name = "ppスライド" & p
picShape.Width = 480   '挿入後幅を調整する

↑これが、謎の480です、ここは自由に合わせます。※だったら、この480も定数にしろって・・いまさら？

960は、PowerPointのキャンパスの幅で960です。
※おっと、16:9じゃなくて4:3のスライド、A3巨大だと違うよね・・・次回の課題ですね。

話を戻して、
Start_X = rBASE.Offset(y, 4) * スケール調整 'ppのLeft
Start_Y = rBASE.Offset(y, 5) * スケール調整 'ppのTop
の計算で、Excelに貼り付けた画像とPowerPointで保存したスクショもどきの位置を合わせました。

4.おわりの挨拶

まだまだ、位置の取り方だったり、いろいろとありますが、
確認作業のヒントとなれば幸いです。

次は、確認したら、数値を直して書き込んだり？
Excel上で修正した値をパワポに戻す作業かなぁ。

手前味噌3:少し前にやった、戻す系の作業は下記の動画を見てください
Excelを使いパワポの図形やテキストを大量に移動したい
ken3memo.hatenablog.com
https://youtu.be/zYczLG7wF9E?si=SdaYTsO5G0F-kcd7&t=996
↑Excelで編集した値で位置を調整してます

パワーポイント資料作りの時短となれば、幸いです。

#excelvba #エクセル #マクロ #デバッグ #矢印 #Shapes #AddConnector #パワーポイント

イラスト食堂男性会社員が複雑にからまったスパゲッティを苦戦しながら急いで食べています