如何用VBA插入一个线段？？？

冰封气流

大佬，如何用 VBA在文档里插入一条粗细、大小一致的线段呢？？？
文档在此， 文档.zip (12.28 KB, 下载次数: 9)

2021-5-25 23:21 上传

点击文件名下载附件

现在这谢谢大佬的解答

shenjianrong163

1. Sub test()
   
2.     With ActiveDocument.Shapes.AddLine(100, 80, 500, 80).Line
   
3.         .Weight = 2.25 '线条粗细
   
4.         .ForeColor.RGB = RGB(0, 0, 0) '线条颜色
   
5.     End With
   
6. End Sub

复制代码

冰封气流

shenjianrong163 发表于 2021-5-27 00:00

十分感谢，完美的解决了我的问题

ke3088

Sub test()
    ActiveDocument.Shapes.AddLine(10, 145, 400, 145).Select '1磅＝0.353毫米＝0.0353厘米
    ActiveDocument.Shapes(1).Select
    With Selection.ShapeRange
         With .Line
              .Weight = 6
              .DashStyle = msoLineSolid '线条线型，实线 msoLineSolid　虚线 msoLineDashDotDot
              .Style = msoLineThickThin '线条样式，单线 msoLineSingle　武文线 msoLineThickThin
              '文武线 msoLineThinThick
              .ForeColor.RGB = RGB(255, 0, 0) '前景色，红色
              .BackColor.RGB = RGB(255, 0, 0) '背景色，红色
         End With
        '水平相对位置，页面 wdRelativeVerticalPositionPage　页边距 wdRelativeHorizontalPositionMargin
        .RelativeHorizontalPosition = wdRelativeVerticalPositionPage
        '相对垂直位置，页面 wdRelativeVerticalPositionPage　页边距 wdRelativeHorizontalPositionMargin
        .RelativeVerticalPosition = wdRelativeVerticalPositionPage
        .Left = CentimetersToPoints(2.1) '左页边距,厘米
        .Top = CentimetersToPoints(4.7601) '上页边距,厘米
        .Width = CentimetersToPoints(17) '线条宽度,厘米
        .Height = CentimetersToPoints(0) '线条高度,厘米
        .LockAnchor = True '锁定标记，是 True　否 False
        .LayoutInCell = False '表格单元格中，是 True　否 False
        .WrapFormat.AllowOverlap = True '重叠，是 True　否 False
        .ZOrder 5 '文字下面
    End With
End Sub