バネマスのバネ 自動作成 PowerPoint

はじめに

振動を研究している方なら必ず下図のようなバネマス系のモデルをPowerPointで作成したことがあると思います。

このバネのジグザグの線を描くの面倒ですよね….。直線で作成すると下図のように「あれジグザグの感覚が微妙にずれてるな」とか、「角の部分が汚いな」とか….。

バネのジグザグなんて資料作成の本質ではないのに、なんか気になってしまうのは私だけではないはず!

ということで、マクロ機能を使って綺麗にバネの線を作るコードを書いてみました。

マクロ

Sub バネの作成()

Dim zigzagNum As String
Dim zigzagSize As Single
Dim freeFormBuilder As freeFormBuilder
Dim sld As Slide
Dim shp As Shape

'ジグザグ線の山数を入力
zigzagNum = InputBox("ジグザグ線の山数を入力してください。")

'数値以外が入力された場合はマクロを終了
If IsNumeric(zigzagNum) Then
ElseIf zigzagNum = "" Then
Exit Sub
Else
msg = "数値を入力してください。"
MsgBox msg
Exit Sub
End If

'ジグザグ線のサイズ
zigzagSize = Round(1 * 720 / 25.4, 1) * 4

'選択中のスライド番号を取得
Set sld = ActivePresentation.Slides(ActiveWindow.View.Slide.SlideIndex)

'始点の位置
Set freeFormBuilder = sld.Shapes.BuildFreeform(msoEditingCorner, 0, zigzagSize / 2)

'頂点を追加
freeFormBuilder.AddNodes msoSegmentLine, msoEditingAuto, zigzagSize / 2, zigzagSize / 2

'繰り返し処理
For i = 1 To zigzagNum * 2 - 1

'X軸の位置
x = zigzagSize / 4 * i + zigzagSize / 2

'偶数、奇数の判定
If (i Mod 2) = 0 Then
'偶数時のY軸の位置
y = zigzagSize
ElseIf i = zigzagNum * 2 - 1 Then
y = zigzagSize / 2
Else
'奇数時のY軸の位置
y = 0
End If

'頂点を追加
freeFormBuilder.AddNodes msoSegmentLine, msoEditingAuto, x, y

Next i
'頂点を追加
freeFormBuilder.AddNodes msoSegmentLine, msoEditingAuto, x + zigzagSize / 2, y

'ジグザグ線を作成
Set shp = freeFormBuilder.ConvertToShape
'線幅
shp.Line.Weight = 1
'線の色
shp.Line.ForeColor.RGB = RGB(0, 0, 0)

End Sub

コメント