在WORD中画带箭头的线段的VBA代码如何写？

请教：在WORD中画带箭头的线段的VBA代码如何写？左箭头；右箭头；双向前头分别如何写？
下面是画直线的VBA：
    Set XlineNew = ActiveDocument.Shapes.AddLine(BeginX:=200, BeginY:=20, EndX:=200, EndY:=50)


画带箭头的线段，守柔版主已经解决（见2楼），那我再问：比如我用
Set XlineNew = ActiveDocument.Shapes.AddLine(BeginX:=200, BeginY:=20, EndX:=200, EndY:=50)
Set XlineNew = ActiveDocument.Shapes.AddLine(BeginX:=240, BeginY:=20, EndX:=240, EndY:=50)
画了两条线段，能不能用VBA代码来组合刚才的两条线段呢？

[ 本帖最后由 yb010 于 2010-6-22 22:28 编辑 ]

示例
该示例为活动文档添加一条线段。线段的起点有一个短且窄的椭圆，终点有一个长且宽的三角形。

Dim docActive As Document

Set docActive = ActiveDocument

With docActive.Shapes.AddLine(100, 100, 200, 300).Line
    .BeginArrowheadLength = msoArrowheadShort
    .BeginArrowheadStyle = msoArrowheadOval
    .BeginArrowheadWidth = msoArrowheadNarrow
    .EndArrowheadLength = msoArrowheadLong
    .EndArrowheadStyle = msoArrowheadTriangle
    .EndArrowheadWidth = msoArrowheadWide
End With

还是版主好，非常感谢版主百忙中回答俺的问题。谢谢！
太凶呀！VBA完全是无所不能的样，只有我想不到的，没有版主做不到的！

[ 本帖最后由 yb010 于 2010-6-22 22:16 编辑 ]

再问：比如我用
Set XlineNew = ActiveDocument.Shapes.AddLine(BeginX:=200, BeginY:=20, EndX:=200, EndY:=50)
Set XlineNew = ActiveDocument.Shapes.AddLine(BeginX:=240, BeginY:=20, EndX:=240, EndY:=50)
画了两条线段，能不能用VBA代码来组合刚才的两条线段呢？

Sub Example()
    Dim XlineNew_1 As Shape
    Dim XlineNew_2 As Shape
    Dim vntArray As Variant
    With ActiveDocument.Shapes
        Set XlineNew_1 = .AddLine(BeginX:=200, BeginY:=20, EndX:=200, EndY:=50)
        Set XlineNew_2 = .AddLine(BeginX:=240, BeginY:=20, EndX:=240, EndY:=50)
        vntArray = Array(XlineNew_1.Name, XlineNew_2.Name)
        .Range(vntArray).Group
    End With
End Sub

谢谢版主，终于应用你的解答，把多个线条组合起来了！这是我写的代码，望赐教！

Sub 画坐标系()
  Dim n1 As String, n2 As String, Xmax As String, Ymax As String, nn As String
  Const n As Integer = 240  '设置方格左上角的起始位置
yb1:  Xmax = InputBox("请输入需要多少刻度单位：", Xmax)
  If Xmax = "" Or Xmax < "1" Then
     MsgBox "刚才你的输入有误，请您重新输入！"
     GoTo yb1:
  End If
ReDim daima(1 To Xmax+2)
ReDim XlineNew(Xmax+2) As Shape
With ActiveDocument.Shapes
            For i = 1 To Xmax +1
                  Set XlineNew(i) = .AddLine(BeginX:=n + 20 * i, BeginY:=n, EndX:=n + 20 * i, EndY:=n + 5)
                  daima(i) = XlineNew(i).Name
            Next i
            Set XlineNew(Xmax + 2) = .AddLine(n, n + 5, n + 5 + 20 * (Xmax + 2), n + 5)
            daima(Xmax + 2) = XlineNew(Xmax + 2).Name
            With XlineNew(Xmax + 2).Line
               '.BeginArrowheadLength = msoArrowheadShort
              ' .BeginArrowheadStyle = msoArrowheadOval
              ' .BeginArrowheadWidth = msoArrowheadNarrow
                .EndArrowheadLength = msoArrowheadLong
                .EndArrowheadStyle = msoArrowheadTriangle
                .EndArrowheadWidth = msoArrowheadWidthMedium
            End With
           .Range(daima).Group
    End With
End Sub

可利用此代码制作坐标系！

[ 本帖最后由 yb010 于 2010-6-23 21:00 编辑 ]

谢谢yb010MM的代码，巾帼不让须眉！向您学习！
测试了一下6楼的代码，提示"运行时错误"9",下标越界"

[ 本帖最后由 tangqingfu 于 2010-6-23 20:55 编辑 ]

已改，再试

PF！!测试通过！
谢谢yb010MM的分享！
能否也提供个不带箭头的线段的VBA代码？

去掉
  With XlineNew(Xmax + 2).Line
               '.BeginArrowheadLength = msoArrowheadShort
              ' .BeginArrowheadStyle = msoArrowheadOval
              ' .BeginArrowheadWidth = msoArrowheadNarrow
                .EndArrowheadLength = msoArrowheadLong
                .EndArrowheadStyle = msoArrowheadTriangle
                .EndArrowheadWidth = msoArrowheadWidthMedium
            End With
你试试

如下面画的方格坐标，用全选然后组合会连文档中其它图形也组合，请问版主怎样解决？
Private Sub CommandButton1_Click()
Const n As Integer = 180  '设置方格左上角的起始位置
  Dim i, j As Single  '设置两个i,j循环变量
  Dim Xmax, Ymax As Single  '设置X和Y方格最大的变量值
  Dim XlineNew As Shape  '创建水平格数XlineNew变量为Shape
  Dim YlineNew As Shape  '创建竖直格数YlineNew变量为Shape
  Xmax = Me.TextBox2   'TextBox2的值赋给Xmax
  Ymax = Me.TextBox1  'TextBox1的值赋给Ymax

  For i = 0 To Xmax
    Set XlineNew = ActiveDocument.Shapes.AddLine(BeginX:=n + 10 * i, BeginY:=n, EndX:=n + 10 * i, EndY:=n + 10 * Ymax)
' .Select
  Next
  '画水平上的方格总数
  For j = 0 To Ymax
  Set YlineNew = ActiveDocument.Shapes.AddLine(BeginX:=n, BeginY:=n + 10 * j, EndX:=n + 10 * Xmax, EndY:=n + 10 * j)
' .Select
  Next
  '画竖直上的方格总数
  ActiveDocument.Shapes.AddLine(n, 160, n, 180).Select
    Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
    Selection.ShapeRange.Line.EndArrowheadLength = msoArrowheadLengthMedium
    Selection.ShapeRange.Line.EndArrowheadWidth = msoArrowheadWidthMedium
    Selection.ShapeRange.Flip msoFlipHorizontal
    Selection.ShapeRange.Flip msoFlipVertical
  '.Select
  ActiveDocument.Shapes.AddLine(n + Xmax * 10, n + Ymax * 10, n + Xmax * 10 + 20, n + Ymax * 10).Select
    Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
    Selection.ShapeRange.Line.EndArrowheadLength = msoArrowheadLengthMedium
    Selection.ShapeRange.Line.EndArrowheadWidth = msoArrowheadWidthMedium
    Selection.ShapeRange.Flip msoFlipVertical
' .Select
  ActiveDocument.Shapes.SelectAll
  Selection.ShapeRange.Group.Select
    UserForm1.HIDE
    End Sub