在 Word 和 PowerPoint 中幫程式加上行號
Tags: word, powerpoint, office
Published: 2023-02-15 04:13:01

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

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

## Word 的 VBA

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

```vb
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
```

1. 使用的方式就是把要加行號的區域選起來, 在執行上述的 VBA 巨集即可。

3. 在 Word 中, 可以從 [`ActiveWindow.Selection`](https://learn.microsoft.com/en-us/office/vba/api/word.selection) 取得選取區域, 並依據它的 [`type`](https://learn.microsoft.com/en-us/office/vba/api/word.selection.type) 判斷選取區域的[類型](https://learn.microsoft.com/en-us/office/vba/api/word.wdselectiontype)。

3. 要取得特定區域的內容, 必須先取得對應的 [`Range`](https://learn.microsoft.com/en-us/office/vba/api/word.range) 物件, `Range` 物件相當於是文件中的指位器, 標示出文件中的一個範圍, 透過它就可以更改此範圍的樣式或是文字內容。

4. `Range` 內的 [`Paragraphs`](https://learn.microsoft.com/en-us/office/vba/api/word.paragraphs) 集合物件包含有範圍內所有的段落, 可用索引取得個別段落的 [`Paragraph`](https://learn.microsoft.com/en-us/office/vba/api/word.paragraph) 物件, 即可透過它的 `range` 屬性取得此段落對應的範圍物件, 再利用 `Range` 物件的 [`insertBefore()`](https://learn.microsoft.com/en-us/office/vba/api/word.range.insertbefore) 方法在段落前面加上行號。

5. 要注意的是, 新增的內容其樣式會跟段落開頭的樣式一致, 因此我們利用 `Range` 物件的 [`setRange()`](https://learn.microsoft.com/en-us/office/vba/api/word.range.setrange) 方法取得剛剛新加入行號的範圍, 將此範圍內的字體顏色改成固定的灰色, 並且取消粗體。
6. 程式也一開頭先計算總行數, 並依此得到行號應該要有幾位數, 並在行號開頭補 '0'。

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

    ```vb
    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 中的寫法如下：

```vb
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, 但還是有以下差異：

1. 選取區的範圍是 [`textRange`](https://learn.microsoft.com/en-us/office/vba/api/powerpoint.textrange) 物件, 判斷選取區類型的常數開頭是代表 PowerPoint 的 'pp'。

2. `textRange` 有 [`Paragraphs()`](https://learn.microsoft.com/en-us/office/vba/api/powerpoint.textrange.paragraphs) 與 [`lines()`](https://learn.microsoft.com/en-us/office/vba/api/powerpoint.textrange.lines) 可以段落或是行為單位取得範圍內的子範圍, 後者是以顯示時的行為單位, 自動折行就會將單一段落變成多行。

3. `textRange` 的 [`insertBefore()`](https://learn.microsoft.com/en-us/office/vba/api/powerpoint.textrange.insertbefore) 會傳回新加入內容的 `textRange` 物件, 所以不需要像是 Word 那樣要自己取出新加入行號部分的範圍物件。

4. PowerPoint 一樣要注意非折行空白字元的問題, 不過 PowerPoint (我使用的是 2016) 的搜尋取代並沒有像是 Word 的萬用字元可用, 所以要使用 [`chrW(160)`](https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/chr-function)(注意 `CharW` 才能表示 Unicode 字元)  來當目標字元。由於 `textRange` 的 [`replace`](https://learn.microsoft.com/en-us/office/vba/api/powerpoint.textrange.replace) 只會取代第一個找到的目標字串, 因此另外撰寫了如下的工具函式透過迴圈取代所有的目標字串：

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

## 結語

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