excelで図形の真ん中に線を引くマクロ

質問

みなさん教えてください。

今エクセルで、添付図のような図を描いています。
そこで、教えて頂きたいことがあります。

図形１にＡのように、縦に真ん中のラインを引き、ＡとＢの間Ｌ（単位：ｍｍ）を知りたいと思います。
これをマクロで行うことは可能でしょうか？

みなさん教えてください。

お願いします

回答No.2

end-u

ActiveSheetの１、２番目のShapesを対象に処理するサンプル。

Sub try()
　　Dim x(1) As Single
　　Dim y(1) As Single
　　Dim z As Single

　　With ActiveSheet
　　　　With .Shapes(1)
　　　　　　x(0) = .Left + .Width / 2
　　　　　　y(0) = .Top - 100
　　　　　　y(1) = .Top + .Height
　　　　End With
　　　　With .Shapes(2)
　　　　　　x(1) = .Left + .Width / 2
　　　　　　z = .Top - 100
　　　　　　If z < y(0) Then y(0) = z
　　　　　　z = .Top + .Height
　　　　　　If z > y(1) Then y(1) = z
　　　　End With
　　　　With .Lines.Add(x(0), y(0), x(0), y(1))
　　　　　　.Border.LineStyle = msoLineSquareDot
　　　　　　With .ShapeRange.Duplicate
　　　　　　　　.Left = x(1)
　　　　　　　　.Top = y(0)
　　　　　　End With
　　　　End With
　　　　y(0) = y(0) + 50
　　　　With .Lines.Add(x(0), y(0), x(1), y(0))
　　　　　　.ArrowHeadStyle = xlDoubleClosed
　　　　　　z = .Width
　　　　End With
　　End With
　　MsgBox Application.Round(z * 3528 / 1000, 0)
End Sub

取り敢えずExcel2003環境にて動作確認してます。