ボンジュール・マドモアゼル

本サイトの情報は自己責任にてご利用下さい。

[Microsoft Excel] フリーフォーム AddNodes エラー回避策

 

Excel 2000 で、オートシェイプの曲線(フリーフォーム)をVBA で作成する際、
曲線上の隣り合う頂点が近すぎる場合に次のようなエラーが発生する。

実行時エラー'1004':
アプリケーション定義またはオブジェクト定義のエラーです。

この不具合については、Excel2000におけるフリーフォーム描画の不具合 が参考になる。

回避策は、一度、十分に間隔の空けた頂点で曲線を描き、
その後、本来の座標値を再設定することである。
思った形にならないときは、座標値の再設定や、
頂点の自動設定を何度か繰り返すことである。

例)
エラーの発生するコード
With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, 20#, 15#)
    .AddNodes msoSegmentCurve, msoEditingAuto, 17.5, 19.33013
    .AddNodes msoSegmentCurve, msoEditingAuto, 12.5, 19.33013
    .AddNodes msoSegmentCurve, msoEditingAuto, 10#, 15#
    .AddNodes msoSegmentCurve, msoEditingAuto, 12.5, 10.66987
    .AddNodes msoSegmentCurve, msoEditingAuto, 17.5, 10.66987
    .AddNodes msoSegmentCurve, msoEditingAuto, 20#, 15#
    .ConvertToShape
End With


エラーの発生しないコード
'とりあえず,全座標値を3倍してフリーフォームを作成
With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, 20# * 3#, 15# * 3#)
    .AddNodes msoSegmentCurve, msoEditingAuto, 17.5 * 3#, 19.33013 * 3#
    .AddNodes msoSegmentCurve, msoEditingAuto, 12.5 * 3#, 19.33013 * 3#
    .AddNodes msoSegmentCurve, msoEditingAuto, 10 * 3#, 15 * 3#
    .AddNodes msoSegmentCurve, msoEditingAuto, 12.5 * 3#, 10.66987 * 3#
    .AddNodes msoSegmentCurve, msoEditingAuto, 17.5 * 3#, 10.66987 * 3#
    .AddNodes msoSegmentCurve, msoEditingAuto, 20 * 3#, 15 * 3#
    Dim aShape As Shape
    Set aShape = .ConvertToShape
End With

'本来の座標値に再設定する
With aShape.Nodes
    'Index は 3つ飛び
    .SetPosition 1, 20#, 15#
    .SetPosition 4, 17.5, 19.33013
    .SetPosition 7, 12.5, 19.33013
    .SetPosition 10, 10#, 15#
    .SetPosition 13, 12.5, 10.66987
    .SetPosition 16, 17.5, 10.66987
End With

'全頂点を自動設定にする
Dim i As Long
For i = 1 To aShape.Nodes.Count
    aShape.Nodes.SetEditingType i, msoEditingAuto
Next
<<??? | ホーム | 明解ガロア理論 [原著第3版] 学習ノート>>

コメント

コメントの投稿

管理者にだけ表示を許可する

画像の文字を半角数字で下記ボックスに記入ください。
文字が読みにくい場合はブラウザの更新をすると新しい文字列が表示されます。