宏代碼如下
==============================================================
Sub Add4line()
'注意錄入的字型必須設定為"Times New Roman",字型大小為13.5號,並且每一行為一個段落
Dim i As Paragraph, MyLine As Shape, Myshape As Shape, myRange As Range, H As Integer
Dim WP As Single, PP As Single, TP As Single, lp As Single, RP As Single, n As Byte
On Error Resume Next '忽略錯誤
With ActiveDocument.PageSetup
WP = .PageWidth '頁面寬度
lp = .LeftMargin '左頁面邊界
RP = .RightMargin '右頁面邊界
End With
'根據地區不同,進行設定,如果未選定內容則在全文檔中進行,反之則在選定地區中進行
If Selection.Type = wdSelectionIP Then
Set myRange = ActiveDocument.Content
Else
Set myRange = Selection.Range
End If
Application.ScreenUpdating = False '關閉螢幕更新
For Each i In myRange.Paragraphs '在指定地區中迴圈
H = H + 1 '計數
With i.Range '對段落進行初始化設定,以達到要求
.Font.Size = 17 '字型大小
.Font.Name = "Rai" '字型
.Font.Color = wdColorBlueGray
.ParagraphFormat.SpaceBefore = 0 '段前為0
.ParagraphFormat.SpaceAfter = 0 '段後為0
.ParagraphFormat.LineSpacing = 23 '行距為23磅
TP = i.Range.Information(wdVerticalPositionRelativeToPage) + 5 '取得段落的垂直位置
For n = 0 To 3 '迴圈劃直線
Set MyLine = ActiveDocument.Shapes.AddLine(lp, TP + 8 * n, WP - RP, TP + 8 * n)
MyLine.Name = "Line" & H & n
MyLine.Line.ForeColor.RGB = RGB(Red:=150, Green:=150, Blue:=150)
If n = 0 Then MyLine.Line.ForeColor.RGB = RGB(Red:=0, Green:=0, Blue:=150)
If n = 2 Then MyLine.Line.Weight = 1.5 '當N為2時的直線為1.5磅
If n = 3 Then MyLine.Line.ForeColor.RGB = RGB(Red:=150, Green:=0, Blue:=0)
Next
'組合四條直線
Set Myshape = ActiveDocument.Shapes.Range(Array _
("Line" & H & 0, "Line" & H & 1, "Line" & H & 2, "Line" & H & 3)).Group
Myshape.ZOrder msoSendBehindText '浮於文字下方
End With
Next
Application.ScreenUpdating = True '恢複螢幕更新
End Sub