有關Word建立英語練字模板的宏

來源:互聯網
上載者:User

宏代碼如下

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

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

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.