在 Word 和 PowerPoint 中幫程式加上行號

在文件或是簡報中, 常常會貼上程式碼內容, 通常我們也會希望可以幫程式碼加上行號, 因此就撰寫了 VBA 來自動完成這項工作。

我的一般流程式使用 VSCode 開啟程式碼檔, 因為 VSCode 可以設定複製文字時同時提供純文字以及 HTML 格式, HTML 格式可以把語法標色的樣式複製到剪貼簿, 所以貼到文章或是投影片時就可以保留語法標色, 非常方便。

Word 的 VBA

以下的 VBA 會幫選取的文字依照段落加上行號：

Sub lineNumber()
    Dim startNumStr, startNum, currLine, maxLineNumber, formatStr
    If ActiveWindow.Selection.Type = wdSelectionNormal Then
      ' 因為 VSCode 是以 HTML 格式複製帶顏色的文字到剪貼簿
      ' 直接貼上時 &nbsp 會被換成 Unicode 的 #C2A0 不折行空白字元
      ' 在 word 中是以萬用字元 ^s 來表示這個字元
      ' 先將之取代掉, 避免複製到一般的開發環境執行時出錯
      Call flag_replace_all("^s", " ", False, True)
      With ActiveWindow.Selection.Range ' 取得選取範圍
          .Font.Name = "Consolas"      ' 全部改用 Consolas 等寬字體
          .Font.Italic = False         ' 取消斜體
          startNumStr = InputBox("請輸入起始行號", "起始行號", "1") ' 取得起始行號
          startNum = CInt(startNumStr)                         ' 轉成數值

          maxLineNumber = startNum + .Paragraphs.Count - 1                ' 取得最後一行行號
          formatStr = String(Int(Log(maxLineNumber) / Log(10)) + 1, "0")  ' 以總位數建立對應數量的 '0' 字串
          For currLine = 1 To .Paragraphs.Count
              Set currRange = .Paragraphs(currLine).Range                 ' 取得目前段落的範圍
              currRange.InsertBefore (Format(startNum, formatStr) & ": ") ' 在段落前面加上帶入行號的字串
              ' 取得新加入行號部分的範圍
              currRange.SetRange _
                  Start:=currRange.Start, _
                  End:=currRange.Start + Len(formatStr) + 1
              ' 設定行號部分為不加粗的固定字體顏色, 避免被段落原始開頭字體影響
              currRange.Font.Color = RGB(115, 115, 115)
              currRange.Font.Bold = False

              startNum = startNum + 1
          Next
      End With
    End If
End Sub

使用的方式就是把要加行號的區域選起來, 在執行上述的 VBA 巨集即可。
在 Word 中, 可以從 ActiveWindow.Selection 取得選取區域, 並依據它的 type 判斷選取區域的類型。
要取得特定區域的內容, 必須先取得對應的 Range 物件, Range 物件相當於是文件中的指位器, 標示出文件中的一個範圍, 透過它就可以更改此範圍的樣式或是文字內容。
Range 內的 Paragraphs 集合物件包含有範圍內所有的段落, 可用索引取得個別段落的 Paragraph 物件, 即可透過它的 range 屬性取得此段落對應的範圍物件, 再利用 Range 物件的 insertBefore() 方法在段落前面加上行號。
要注意的是, 新增的內容其樣式會跟段落開頭的樣式一致, 因此我們利用 Range 物件的 setRange() 方法取得剛剛新加入行號的範圍, 將此範圍內的字體顏色改成固定的灰色, 並且取消粗體。
程式也一開頭先計算總行數, 並依此得到行號應該要有幾位數, 並在行號開頭補 '0'。

如果是從 VSCode 以 HTML 格式複製貼到 Word 中, 程式碼中的空白字元有些會是 &nbsp, 這在貼到 Word 上時會被取代為 Unicode 字碼 0xA0 (UTF8 0xC0A0) 的不折行空白字元, 如果不置換回空白字元, 從 Word 檔中複製出來使用, 就可能會因為這個看起來像是正常空白的字元而編譯錯誤。因此, 程式一開頭就用空白字元置換 Word 中代表不折行空白的萬用字元 "^s", 這個置換動作使用以下的工具函式：

Sub flag_replace_all(target, replacement, isBold, useWildcard)
    Selection.Find.ClearFormatting
    If isBold Then
        Selection.Find.Font.Bold = True
    End If
    Selection.Find.replacement.ClearFormatting
    With Selection.Find
        .Text = target
        .replacement.Text = replacement
        .Forward = True
        .Wrap = wdFindContinue
        .Format = isBold
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = useWildcard
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

其中第 3 個參數可以指定目標字串是否要具有粗體樣式, 而第 4 個參數則是指地搜尋時是否使用萬用字元。

PowerPoint 的 VBA

在 PowerPoint 中的寫法如下：

Sub lineNumber()
    Dim startNumStr, startNum, currLine, maxLineNumber, formatStr
    With ActiveWindow.Selection
        If .Type = ppSelectionText And .TextRange.Length > 0 Then

            ' 從 VSCode 複製過來的是 HTML 格式內容
            ' 會將 &nbsp 以 Unicode 0xA0 (UTF8 0xC0A0) 的字元取代
            ' 後續從 PPT 複製原始碼時就會造成編譯錯誤的問題
            ' 這裡將之取代為正常的空白字元
            Call replaceAllInRange(.TextRange, ChrW(160), " ")

            ' 從 VSCode 複製過來時,空白行會被當轉成 Chr(11)
            ' 會跟下一行接在一起, 變成不是一個 paragraph
            ' 這裡取代掉強制變成單一個段落
            Call replaceAllInRange(.TextRange, ChrW(11), vbNewLine)

            .TextRange.Font.Name = "Consolas"
            startNumStr = InputBox("請輸入起始行號", "起始行號", "1")
            startNum = CInt(startNumStr)
            maxLineNumber = startNum + .TextRange.Paragraphs.Count - 1
            formatStr = String(Int(Log(maxLineNumber) / Log(10)) + 1, "0")
            For currLine = 1 To .TextRange.Paragraphs.Count
                Set newRange = .TextRange.Paragraphs(currLine).InsertBefore( _
                    Format(startNum, formatStr) & ": ")
                With newRange.Font
                    .Color.RGB = RGB(115, 115, 115)
                    .Bold = False
                End With

                startNum = startNum + 1
            Next
        End If
    End With
End Sub

PowerPoint 和 Word 的寫法類似, 使用的方式一樣是把要加行號的區域選起來, 再執行上述的 VBA 巨集即可。不過 PowerPoint 雖然和 Word 都是同一家族的軟體, 使用的也都是 VBA, 但還是有以下差異：

選取區的範圍是 textRange 物件, 判斷選取區類型的常數開頭是代表 PowerPoint 的 'pp'。
textRange 有 Paragraphs() 與 lines() 可以段落或是行為單位取得範圍內的子範圍, 後者是以顯示時的行為單位, 自動折行就會將單一段落變成多行。
textRange 的 insertBefore() 會傳回新加入內容的 textRange 物件, 所以不需要像是 Word 那樣要自己取出新加入行號部分的範圍物件。

PowerPoint 一樣要注意非折行空白字元的問題, 不過 PowerPoint (我使用的是 2016) 的搜尋取代並沒有像是 Word 的萬用字元可用, 所以要使用 chrW(160)(注意 CharW 才能表示 Unicode 字元) 來當目標字元。由於 textRange 的 replace 只會取代第一個找到的目標字串, 因此另外撰寫了如下的工具函式透過迴圈取代所有的目標字串：

' TextRange 物件的 replace 方法只會取代第一個,
' 請傳回代表取代區域的 TextRange 物件
' 若沒找到目標字串會傳回 Nothing
' 因此以迴圈方式取代所有出現目標字串的地方
Sub replaceAllInRange(r, fStr, rStr)
  Set tempRange = r
  Do While Not tempRange Is Nothing
    Set tempRange = r.Replace(fStr, rStr)
  Loop
End Sub

另外, 雖然 textRange.Paragraphs 可以段落的方避免自動折行的問題, 不過什麼都沒有的空白行在貼到 PowerPoint 時會變成單一個 Chr(11), 沒有換行字元, 因此就跟下一個段落接在一起變成只有一段了。為了避免這個問題, 也在一開始就先 Chr(11) 置換成 vbNewLine 強制變成單一段落。

結語

雖然看似簡單的幫程式加行號, 不過都還是有許多細微處需要注意, 希望這些 VBA 巨集可以幫大家省掉許多手工。

Blog

在 Word 和 PowerPoint 中幫程式加上行號

codemee

Word 的 VBA

PowerPoint 的 VBA

結語

Join Our Newsletter. No Spam, Only the good stuff.

Related