VBA宏實現Word論文自動排版

shouzhuw 2024-09-03 發布于四川

展開全文

一、靈感與動機

作為一名即將畢業的大四學生，不僅經歷了設計、編寫系統的痛苦，還經歷了撰寫論文的煩惱，尤其是最后論文排版階段，非常的繁瑣和費時。所以我就希望可以有一個自動排版的“腳本”，一開始認為可以通過Python完成（因為Python屬實強大），但經過大量的搜索和學習，我發現Office中給用戶提供了一個宏語言，用戶可以自己通過編碼完成除現有功能外的其他功能。其默認支持VB，此外還有JS和Python也可以進行下載并切換開發環境。

二、現狀與開發過程

在開發的過程中，也是遇到了很多很多困難。最重要的可能還是我還是太菜了ヽ(ー_ー)ノ，目前VBA宏的編寫對Excel的操做更加實用和方便，所以網絡資源中基本都是Excel的教程學習。導致關于Word中使用的VB操做的案例和教程微乎其微，只能自己通過摸索、閱讀文檔和讓ChatGPT幫忙。給也想練習的小伙伴一些建議吧，少走彎路：

（1）一開始我參考的開發文檔是VB的，如果你VB不好可以參考，地址：Visual Basic 文檔 - 入門、教程、參考。 | Microsoft Learn

但如果是word中的VBA開發文檔需要參考Microsoft提供的，地址：Visual Basic for Applications (VBA) 的 Word 對象模型 | Microsoft Learn

（2）AI不是全部，不能給你提供直接搬來就能用的代碼，需要你辨識和改變，這才是AI在幫助你編碼中最正確的用法。

三、總體效果

使用VB的窗體與宏功能建立聯系，目前已實現的功能：

（1）目錄樣式

（2）1、2、3...級標題樣式

（3）正文樣式

（4）圖注、表注樣式

（5）表格樣式

（6）頁面設置樣式

（7）摘要（中英）樣式，包括關鍵詞樣式

四、部分功能實現

（1）修改標題樣式（1、2、3...級標題）

以1級標題為例，首先找到類型為“標題 1”的樣式段落，再修改其具體樣式，如加粗、下劃線、傾斜、行距、段前段后等。實現代碼如下：


Sub FormatHeading2()   '修改1級標題
    Dim p As Paragraph
    For Each p In ActiveDocument.Paragraphs
        If p.Style = ActiveDocument.styles('標題 1') Then
            p.Range.Font.Bold = True
            p.Range.Font.Italic = True '設置傾斜
            p.Range.Font.Underline = wdUnderlineSingle '設置下劃線（單下劃線）            
            p.Range.Font.Size = 15
            p.Range.Font.name = '宋體'
            p.Range.ParagraphFormat.Alignment = wdAlignParagraphRight
            p.Range.ParagraphFormat.spaceBefore = 20
            p.Range.ParagraphFormat.spaceAfter = 10
            p.Range.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle   '單倍行距
            p.Range.ParagraphFormat.CharacterUnitFirstLineIndent = 0
            p.Range.ParagraphFormat.FirstLineIndent = CentimetersToPoints(0)
        End If
    Next p
End Sub

其他更多詳細的屬性可自行查閱開發文檔。

（2）修改目錄內容樣式

對于目錄中不同級別的標題的樣式會存在差異，我查找并修改樣式的過程是，先找到所有標題的名稱，不同級別放入不同數組中，在每個數組遍歷尋找第一次出現的段落修改其樣式。注意注意：目錄中的文本屬于超鏈接文本！實現代碼如下（以修改目錄中1級標題為例）：


Sub updateDirectoryContentOneStyle()        '注意超鏈接文本問題
    Dim p As Paragraph
    Dim one() As String
    Dim oneCount As Integer
    Dim i As Integer
    For Each p In ActiveDocument.Paragraphs
        If p.Style = ActiveDocument.styles('標題 1') Then
            ReDim Preserve one(oneCount) '擴展一級標題數組
            one(oneCount) = p.Range.text
            oneCount = oneCount + 1
        End If
    Next p
    '輸出數組中保存的標題內容
    For i = 0 To UBound(one)
        Dim myRange As Range
        Dim myStyle As Style
        Set myRange = ActiveDocument.Content
        myRange.Find.Execute FindText:=one(i), Forward:=True  '查找
        If myRange.Find.Found = True Then
            With myRange
                .Font.Bold = False
                .Font.name = '宋體'
                .Font.Size = 14
            End With
        End If
    Next
End Sub

（3）查找特定文本并修改其樣式

本文以查找“關鍵詞”三字為例。使用Find關鍵字進行查找，找到后修改其樣式即可。更多的詳細屬性請參考開發文檔，實現代碼如下：


Sub findText()
    Set myRange = ActiveDocument.Content
    myRange.Find.Execute FindText:='關鍵詞', Forward:=True
    If myRange.Find.Found = True Then
        With myRange
            .Font.Bold = False
            .ParagraphFormat.Alignment = wdAlignParagraphLeft '左對齊
            .Font.Color = wdColorBlack
            .Font.name = '黑體'
            .Font.Size = 14
            .ParagraphFormat.PageBreakBefore = False
            .ParagraphFormat.CharacterUnitFirstLineIndent = 0   '去除首行縮進
            .ParagraphFormat.FirstLineIndent = CentimetersToPoints(0)
        End With
    End If
End Sub

（4）表格樣式

修改表格樣式，可以查閱開發文檔與網絡資源。我也參考了AI的一些代碼。實現代碼如下（最基本的不加樣式的表格）：


Sub execlOperate()   '表格樣式操作
    Application.ScreenUpdating = False  '關閉屏幕刷新
    Application.DisplayAlerts = False
    On Error Resume Next  '忽略錯誤
    Dim mytable As Table, i As Long
    If Selection.Information(wdWithInTable) = True Then i = 1
    For Each mytable In ActiveDocument.Tables
        If i = 1 Then Set mytable = Selection.Tables(1)
        With mytable
            '取消底色
            .Shading.ForegroundPatternColor = wdColorAutomatic
            .Shading.BackgroundPatternColor = wdColorAutomatic
            Options.DefaultHighlightColorIndex = wdNoHighlight
            .Range.HighlightColorIndex = wdNoHighlight
            .Style = '表格主題'
            '單元格邊距
            .TopPadding = PixelsToPoints(0, True) '設置上邊距為0
            .BottomPadding = PixelsToPoints(0, True) '設置下邊距為0
            .LeftPadding = PixelsToPoints(0, True)  '設置左邊距為0
            .RightPadding = PixelsToPoints(0, True) '設置右邊距為0
            .Spacing = PixelsToPoints(0, True) '允許單元格間距為0
            .AllowPageBreaks = True               '允許斷頁
            '.AllowAutoFit = True                 '允許自動調整尺寸
            '設置邊框
            .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
            .Borders(wdBorderRight).LineStyle = wdLineStyleNone
            .Borders(wdBorderTop).LineStyle = wdLineStyleNone
            .Borders(wdBorderBottom).LineStyle = wdLineStyleNone
            .Borders(wdBorderTop).LineStyle = wdLineStyleThinThickMedGap
            .Borders(wdBorderTop).LineWidth = wdLineWidth2pt
            .Borders(wdBorderBottom).LineStyle = wdLineStyleThickThinMedGap
            .Borders(wdBorderBottom).LineWidth = wdLineWidth225pt
            With .Rows
                .WrapAroundText = False '取消文字環繞
                .Alignment = wdAlignRowCenter '表水平居中  wdAlignRowLeft '左對齊
                .AllowBreakAcrossPages = False '不允許行斷頁
                .HeightRule = wdRowHeightExactly '行高設為最小值   wdRowHeightAuto '行高設為自動
                .Height = CentimetersToPoints(0) '上面縮進量為0
                .LeftIndent = CentimetersToPoints(0) '左面縮進量為0
            End With
            With .Range
                With .Font '字體格式
                    .name = '宋體'
                    .name = 'Times New Roman'
                    .Color = wdColorAutomatic '自動字體顏色
                    .Size = 12
                    .Kerning = 0
                    .DisableCharacterSpaceGrid = True
                End With
                With .ParagraphFormat '段落格式
                    .CharacterUnitFirstLineIndent = 0 '取消首行縮進
                    .FirstLineIndent = CentimetersToPoints(0) '取消首行縮進
                    .LineSpacingRule = wdLineSpaceSingle '單倍行距  wdLineSpaceExactly '行距固定值
                    '.LineSpacing = 20 '設置行間距為20磅，配合行距固定值
                    .Alignment = wdAlignParagraphCenter '單元格水平居中
                    .AutoAdjustRightIndent = False
                    .DisableLineHeightGrid = True
                End With
                .Cells.VerticalAlignment = wdCellAlignVerticalCenter  '單元格垂直居中
            End With
            '設置首行格式
            .Cell(1, 1).Select ' 選中第一個單元格
            With Selection
                .SelectRow '選中當前行
                Selection.Rows.HeadingFormat = wdToggle '自動標題行重復
                .Range.Font.Bold = False '表頭加粗黑體
                .Shading.ForegroundPatternColor = wdColorAutomatic '首行自動顏色
                '.Shading.BackgroundPatternColor = -603923969 '首行底紋填充
            End With
            '自動調整表格
            .Columns.PreferredWidthType = wdPreferredWidthAuto
            .AutoFitBehavior (wdAutoFitContent) '根據內容調整表格
            .AutoFitBehavior (wdAutoFitWindow) '根據窗口調整表格
        End With
        If i = 1 Then Exit For
    Next
    Err.Clear: On Error GoTo 0             '恢復錯誤捕捉
    Application.DisplayAlerts = True       '開啟提示
    Application.ScreenUpdating = True      '開啟屏幕刷新
End Sub

（5）修改圖注樣式（表注同理）

修改圖注的樣式，我的思路是查找所有的圖片并獲取圖片的上一段文本，修改其樣式。修改表注同理，實現代碼如下。

注：代碼中使用了InlineShape庫，只能查找Word文檔中樣式為嵌入式的圖片。


Sub GetAllImageNextLineText()       '修改所有圖注的樣式
    Dim shp As InlineShape
    Dim nextLine As Range
    For Each shp In ActiveDocument.InlineShapes
        If shp.Type = wdInlineShapePicture Then
            Set para = shp.Range.Paragraphs(1)
            Set nextPara = para.Next
            If Not nextPara Is Nothing Then
                '修改下一行文本的樣式
                With nextPara.Range
                    .ParagraphFormat.Alignment = wdAlignParagraphCenter '文本居中
                    .ParagraphFormat.LineSpacingRule = wdLineSpaceSingle '行距
                    .Font.name = '黑體' '字體名稱
                    .Font.Size = 12    '字體大小
                    .ParagraphFormat.CharacterUnitFirstLineIndent = 0
                    .ParagraphFormat.FirstLineIndent = CentimetersToPoints(0)
                End With
            End If
        End If
    Next shp
End Sub

（6）頁面設置

這里就羅列的一些常用的頁面設置方法，僅供參考和copy。更多詳細的屬性可自行查閱開發文檔。

代碼如下：


Sub installPage()       '修改頁面設置
    Dim doc As Document
    Set doc = ActiveDocument
    With doc.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientPortrait '頁面方向為縱向
        .topMargin = CentimetersToPoints(3.3) '上邊距
        .bottomMargin = CentimetersToPoints(3.3) '下邊距
        .LeftMargin = CentimetersToPoints(2.8)  '左邊距
        .RightMargin = CentimetersToPoints(2.6)  '右邊距
        .Gutter = CentimetersToPoints(0) '裝訂線
        .HeaderDistance = CentimetersToPoints(1.5) '頁眉
        .FooterDistance = CentimetersToPoints(1.75) '頁腳
        .PageWidth = CentimetersToPoints(21) '紙張寬
        .PageHeight = CentimetersToPoints(29.7) '紙張高
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage '節的起始位置：新建頁
        .OddAndEvenPagesHeaderFooter = False '不勾選“奇偶頁不同”
        .DifferentFirstPageHeaderFooter = False '不勾選“首頁不同”
        .VerticalAlignment = wdAlignVerticalTop '頁面垂直對齊方式為“頂端對齊”
        .SuppressEndnotes = False '不隱藏尾注
        .MirrorMargins = False '不設置首頁的內外邊距
        .TwoPagesOnOne = False
        .BookFoldPrinting = False
        .GutterPos = wdGutterPosLeft '裝訂線位于左側
        .LayoutMode = wdLayoutModeLineGrid '版式模式為“只指定行網格”
    End With
End Sub

到此，所有分享結束了，希望上述經歷和代碼可以幫助你們。還有更多功能和方法值得我和你們去研究，感謝瀏覽。有其他好的問題和經驗可以在評論區留言或私信我。?(?????)?

本站是提供個人知識管理的網絡存儲空間，所有內容均由用戶發布，不代表本站觀點。請注意甄別內容中的聯系方式、誘導購買等信息，謹防詐騙。如發現有害或侵權內容，請點擊一鍵舉報。

VBA宏實現Word論文自動排版

一、靈感與動機

二、現狀與開發過程

三、總體效果

四、部分功能實現

三、總體效果

四、部分功能實現