アプリ版:「スタンプのみでお礼する」機能のリリースについて

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

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

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

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

A 回答 (1件)

以下は、オートシェイプの直線で曲線に対して補助線を引くことには違いないのですが、マウスでオートシェイプの周囲の範囲を選択して、マクロを実行したら合計が出せます。

コマンドボタンなどにつけると良いです。係数は、それぞれの環境によってズレがありますから、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
    • good
    • 3
この回答へのお礼

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

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

お礼日時:2010/06/08 06:52

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!