SecondaryUse開発日記

データベース参照ツールを開発しています。そのツールの開発、利用方法秘話などなどの紹介

WORDで選択領域に楕円を描画する

Sub AddmsoShapeOval()
Dim x As Double
Dim y As Double
Dim w As Double
Dim h As Double

'カーソル位置座標取得
x = Selection.Information(wdHorizontalPositionRelativeToPage)
y = Selection.Information(wdVerticalPositionRelativeToPage)
'Selection.EndKey Unit:=wdLine, Extend:=wdMove
'選択範囲の移動
Selection.MoveRight Unit:=wdCharacter, Count:=1
w = Selection.Information(wdHorizontalPositionRelativeToPage)
'選択範囲の移動
'Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=1
h = Selection.Information(wdVerticalPositionRelativeToPage)

'オートシェイプ挿入
ActiveDocument.Shapes.AddShape(msoShapeOval, x, y, w - x, h - y).Select
'ActiveDocument.Shapes.AddShape(msoShapeOval, x, y, w - x, 10).Select
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.WrapFormat.Type = wdWrapFront

Selection.Collapse
End Sub