線路描画マクロ

線路を描くマクロが雑誌に載っていたのでこれは便利だと思い使っていますがこのままでは出来た線路を選択してドラグした場合、ずれることがあるので少し手を加えました、使い方は「オートシェイプ」で適当に線を引いてそれを選択した状態でこのマクロを実行するだけです。

Sub 線路()
　　一番上 = Selection.Top
　　一番左 = Selection.Left

　　With Selection.ShapeRange.Line
　　　　.Weight = 6#
　　　　.Visible = msoTrue
　　　　.Style = msoLineSingle
　　End With
　　Selection.Name = "Senro_1"
　　Selection.Copy
　　ActiveSheet.Paste
　　With Selection.ShapeRange.Line
　　　　.Weight = 4.5
　　　　.Visible = msoTrue
　　　　.Style = msoLineSingle
　　　　.DashStyle = msoLineDash
　　　　.ForeColor.SchemeColor = 9
　　.Visible = msoTrue
　　End With
　　Selection.Name = "Senro_2"
　　Selection.Top = 一番上
　　Selection.Left = 一番左

'以下がずれを防止するおまじない。

　　ActiveSheet.Shapes.Range(Array("Senro_1", "Senro_2")).Group

End Sub

しかし結構面倒、でもちゃんとその操作をメニューから実行できるようにと以下のマクロも載っていたのでこれを一度実行すれば後は右クリックメニューから実行できます。

Sub 線路をメニューに追加()

　　Set 追加メニュー = CommandBars("curve").Controls.Ad
d
　　追加メニュー.Caption = "線路に変換"
　　追加メニュー.OnAction = "線路"

End Sub

Sub 線路メニューリセット()

　　CommandBars("curve").Reset

End Sub

実行前



実行後



こんな感じです。