excelで、曲線の長さを計測する方法

質問

excelで、曲線の長さを計測する方法

オートシェイプの曲線の長さを知るためにはどうしたらよいのでしょうか？
グラフ上の線ではなく、フリーハンド等の曲線も含め、長さを簡単に知る方法がありましたら、教えてください

ちなみに、曲線に沿って、直線を数本引いて、各直線の長さの総和より、近似的に求める方法がありますが、
各直線に対して、図形の書式設定の縦横のサイズから、直線の長さを求めるため
少し手間がかかると思います。

何か、良い方法はないでしょうか？

回答No.1

Wendy02 · ベストアンサー

以下は、オートシェイプの直線で曲線に対して補助線を引くことには違いないのですが、マウスでオートシェイプの周囲の範囲を選択して、マクロを実行したら合計が出せます。コマンドボタンなどにつけると良いです。係数は、それぞれの環境によってズレがありますから、dRATE の部分は、実際に、オートシェイプで、横のラインを引いて右クリックで、正しく出ているか比べてください。

以下の　l（エルの小文字） と、書式の実際の長さで、[ = l / 実際の長さ]　で係数が出ます。
以下の計算は、四捨五入しています。

なお、マウスで囲む時は、オートシェイプよりも一回り大きく選択してください。

'//
Sub LineMeasure()
　'直線のラインの合計を出すマクロ
　Dim rng　As Range
　Dim shp As Variant
　Dim t As Double, p As Double, k As Double, l As Double
　Dim i As Long
　Const dRATE = 0.283　'係数
　If TypeName(Selection) <> "Range" Then
　　MsgBox "セルの範囲を選択してください。", vbExclamation
　　Exit Sub
　End If
　Set rng = Selection
　For Each shp In ActiveSheet.DrawingObjects
　　If Not Intersect(shp.TopLeftCell, rng) Is Nothing Then
　　　If shp.ShapeRange.Type = msoLine Then
　　　　With shp
　　　　　i = i + 1
　　　　　t = .Width
　　　　　p = .Height
　　　　　k = (t ^ 2 + p ^ 2) ^ (1 / 2)
　　　　　l = l + k
　　　　End With
　　　End If
　　End If
　Next
　If i = 0 Then
　　MsgBox "直線ラインが引かれていないか、オートシェイプの範囲が選択されていません。", vbExclamation
　Else
　　MsgBox Int((l / dRATE) * 10 + 0.5) / 10 & "mm"　'l は合計
　End If
End Sub

お礼

素早い解答ありがとうございます。
返答が遅れてすいません。

既に仕事で何度も使わせてもらってます。
ありがとうございました。