有关Word创建英语练字模板的宏

最新推荐文章于 2021-01-07 02:08:25 发布

TANGBABY

最新推荐文章于 2021-01-07 02:08:25 发布

阅读量6k

点赞数

本文链接：https://blog.csdn.net/TANGBABY/article/details/5020477

版权

电脑操作专栏收录该内容

0 篇文章

订阅专栏

这段宏代码展示了如何在Word中用VBA创建四行英语练字模板。代码设置了字体、字号、颜色，并在每个段落中画出不同颜色和粗细的线条，形成练习网格，线条颜色包括蓝色、灰色和红色。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

宏代码如下

==============================================================

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