在文件或是簡報中, 常常會貼上程式碼內容, 通常我們也會希望可以幫程式碼加上行號, 因此就撰寫了 VBA 來自動完成這項工作。
我的一般流程式使用 VSCode 開啟程式碼檔, 因為 VSCode 可以設定複製文字時同時提供純文字以及 HTML 格式, HTML 格式可以把語法標色的樣式複製到剪貼簿, 所以貼到文章或是投影片時就可以保留語法標色, 非常方便。
Word 的 VBA
以下的 VBA 會幫選取的文字依照段落加上行號：
Sub lineNumber()
Dim startNumStr, startNum, currLine, maxLineNumber, formatStr
If ActiveWindow.Selection.Type = wdSelectionNormal Then
' 因為 VSCode 是以 HTML 格式複製帶顏色的文字到剪貼簿
' 直接貼上時   會被換成 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 中, 程式碼中的空白字元有些會是  , 這在貼到 Word 上時會被取代為 Unicode 字碼
0xA0(UTF80xC0A0) 的不折行空白字元, 如果不置換回空白字元, 從 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 格式內容
' 會將   以 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 巨集可以幫大家省掉許多手工。
Top comments (0)