用VBA在WORD中绘制图形及函数图象

用VBA在WORD中绘制图形及函数图象

Sub Macro1()

用VBA在WORD中绘制图形及函数图象

1.绘制一个“开关”图形

'宏 Switch实现在指定位置绘制一个“开关”图形。

Sub Switch()

ActiveDocument.Shapes.AddLine(100, 110, 120, 110).Name = "shp1"

ActiveDocument.Shapes.AddShape(msoShapeOval, 120, 108, 4, 4).Name = "shp2" 'Oval 椭圆形

ActiveDocument.Shapes.AddShape(msoShapeOval, 130, 108, 4, 4).Name = "shp3" ActiveDocument.Shapes.AddLine(134, 110, 154, 110).Name = "shp4"

ActiveDocument.Shapes.AddLine(122, 108, 132, 104).Name = "shp5"

ActiveDocument.Shapes.Range(Array("shp1", "shp2", "shp3", "shp4", "shp5")).Group

End Sub

2.添加绘图画布

'下列示例在新文档中添加绘图画布，然后在绘图画布上添加两个图形，并设置填充和线条属性。

Sub AddInlineCanvas()

Dim docNew As Document

Dim shpCanvas As Shape

Set docNew = Documents.Add

'Add a drawing canvas to the new document

Set shpCanvas = docNew.Shapes.AddCanvas( _

Left:=150, Top:=150, Width:=70, Height:=70)

shpCanvas.WrapFormat.Type = wdWrapInline

'Add shapes to drawing canvas

With shpCanvas.CanvasItems

.AddShape msoShapeHeart, Left:=10, _

Top:=10, Width:=50, Height:=60

.AddLine BeginX:=0, BeginY:=0, _

EndX:=70, EndY:=70

End With

With shpCanvas

.CanvasItems(1).Fill.ForeColor _

.RGB = RGB(Red:=255, Green:=0, Blue:=0)

.CanvasItems(2).Line _

.EndArrowheadStyle = msoArrowheadTriangle

End With

End Sub

3.添加一条贝赛尔曲线

本例向活动文档添加一条两段的贝塞尔曲线，并且将其定位在第二段（文档中至少要有两段，否则出错）。

选择曲线，右击可编辑顶点。

Sub BezierCurve()

Dim sngArray(1 To 7, 1 To 2) As Single

sngArray(1, 1) = 0

sngArray(1, 2) = 0

sngArray(2, 1) = 72

sngArray(2, 2) = 72

sngArray(3, 1) = 100

sngArray(3, 2) = 40

sngArray(4, 1) = 20

sngArray(4, 2) = 50

sngArray(5, 1) = 90

sngArray(5, 2) = 120

sngArray(6, 1) = 60

sngArray(6, 2) = 30

sngArray(7, 1) = 150

sngArray(7, 2) = 90

ActiveDocument.Shapes.AddCurve SafeArrayOfPoints:=sngArray, Anchor:=ActiveDocument.Paragraphs(2).Range

End Sub

4.绘制正弦曲线

'在Word中画正弦曲线

Sub DrawSin()

Dim i As Single, x1 As Single, x2 As Single, x As Single, n As Single Dim sngArray(1 To 100, 1 To 2) As Single

Const PI As Single = 3.1415

x1 = 0 '初始角度值

x2 = 1440 '终止角度值

x = 1440 '终初角度差

n = x / 360 '波数

For i = 1 To 100

sngArray(i, 1) = 100 + 2 * i

sngArray(i, 2) = 200 - 30 * Sin(4 * n * PI * i / 200 + x1)

Next

'添加贝塞尔曲线

ActiveDocument.Shapes.AddCurve SafeArrayOfPoints:=sngArray

End Sub

End Sub