[[20201030115947]]　『グラフの線を書くVBAでエラーが出る』（ユウキ）　ページの最後に飛ぶ

『グラフの線を書くVBAでエラーが出る』（ユウキ）

EXCEL2016を使用しています。
手元に計算とその結果に応じてグラフを書くxls形式のVBAがあります。これは他の人からいただいたものですが、その人も別の人から受け取ったものらしく、作者は不明です。
このVBAを使おうとすると、計算は恐らく大丈夫ですが、グラフを書くところでこんなエラーが出ます↓
実行時エラー '-2147024809 (80070057)':

指定された値は境界を超えています。

引っかかった部分はこんな感じです↓

                        Selection.ShapeRange.Nodes.Insert nnn, msoSegmentLine, msoEditingAuto, xi, yi

過去の検索で保護されているとエラーが出るとの文章を見つけたので、新たにxlsm形式でエクセルを用意し、シート名からVBAから数式の名前の管理まで全てコピーし、保護も全て外したのを確認してから動かしましたが、やはり同じエラーが出てきます。
これはどこを触ればエラーが消えますでしょうか。
以下がエラーが出た部分のコードです。全てだと量が多いので、subからendまでの一区切りのみをまず貼り付けします。

'
'
'
Sub CloseFormDraw(swPn, sysLnType, nPst, mxDrP, DrPxy())
'
'閉じた図形を作図
'

        If (mxDrP - nPst) > 1 Then
'
                            xs = DrPxy(nPst, 1)
                            ys = DrPxy(nPst, 2)
                            xe = DrPxy(mxDrP, 1)
                            ye = DrPxy(mxDrP, 2)
                        ActiveSheet.Shapes.AddLine(xs, ys, xe + 10, ye + 10).Select
                    With Selection.ShapeRange.Line
                        .DashStyle = sysLnType
                    End With
'
'               中間点を挿入する
                            nnn = 0
                For i = nPst + 1 To mxDrP
                            xi = DrPxy(i, 1)
                            yi = DrPxy(i, 2)
                            nnn = nnn + 1
                        Selection.ShapeRange.Nodes.Insert nnn, msoSegmentLine, msoEditingAuto, xi, yi
                Next i
'
'                       終点を起点に移動する
                        Selection.ShapeRange.Nodes.SetPosition ((mxDrP - nPst + 1) + 1), xs, ys
'
'                       起点に移動する
                        Selection.ShapeRange.Nodes.SetPosition 1, xs, ys
'
'                       塗りつぶし
                If swPn <> 0 Then
                        Selection.ShapeRange.Fill.Visible = msoTrue
                        Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 0, 0)
                        Selection.ShapeRange.Fill.BackColor.RGB = RGB(255, 255, 255)
                        Selection.ShapeRange.Fill.Transparency = 0#
                    If swPn = 90 Then
                        Selection.ShapeRange.Fill.Patterned msoPatternLightHorizontal
                    ElseIf swPn = 45 Then
                        Selection.ShapeRange.Fill.Patterned msoPatternLightUpwardDiagonal
                    Else
                        Selection.ShapeRange.Fill.Patterned msoPatternLightVertical
                    End If
                        DoEvents
                End If
'
        End If
End Sub

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

 ちょと実行して試すということができないので、なんとも言えないのですが、

 Nodeの数が多すぎるとか、xiや yi の値がが大きすぎるとか小さすぎるとか、

 そんな理由でエラーになっているのではないでしょうか

 わかりませんけど
（´・ω・`） 2020/10/30(金) 14:17

　同じく、推測の域を出ませんが、以下の様にしたらどうでしょうか？
　確か、直線コネクタは頂点の編集が出来なくなったのでは。（Excel2007以降？）

    ActiveSheet.Shapes.AddLine(xs, ys, xe + 10, ye + 10).Select

↓

    With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, xs, ys)
        .AddNodes msoSegmentLine, msoEditingAuto, xe + 10, ye + 10
        .ConvertToShape.Select
    End With

（きまぐれ） 2020/10/30(金) 15:29

（´・ω・`）さん、（きまぐれ）さん、おふたりともありがとうございます。
（きまぐれ）さんのコードで書き換えたら無事に動きました！
07年代に作成されたものらしいので、まさに古い書き方だったから動かなかった認識で当たっていそうです。
本当に助かりました！
（ユウキ） 2020/10/30(金) 16:18

コメント返信：

[ 一覧(最新更新順) ]

[[20201030115947]] 『グラフの線を書くVBAでエラーが出る』（ユウキ） ページの最後に飛ぶ

[[20201030115947]]　『グラフの線を書くVBAでエラーが出る』（ユウキ）　ページの最後に飛ぶ