企业官网建设流程全解析

假定HTML文件中使用下面的标签实现了注音：

<ruby>鳏<rt>guān</rt></ruby>

将上述HTML片段拷贝到Word文档中后，下面的宏可以将其转换为如下图的Word拼音指南：

Sub ConvertRubyToPhonetic() Dim doc As Document Dim regEx As RegExp Dim matches, match As Object Dim i As Long Dim rng As Range, content As String Dim phonetic As String Application.ScreenUpdating = False Set doc = ActiveDocument docText = doc.content.Text Set regEx = New RegExp regEx.Global = True ' 全局查找 regEx.IgnoreCase = True ' 忽略大小写 regEx.Pattern = "<ruby>(.+?)<rt>(.+?)</rt></ruby>" Set matches = regEx.Execute(docText) On Error Resume Next If matches.Count > 0 Then For i = matches.Count - 1 To 0 Step -1 Set match = matches(i) content = match.SubMatches(0) ' 取文字 phonetic = match.SubMatches(1) ' 取拼音 Set rng = doc.Range(Start:=match.FirstIndex, _ End:=match.FirstIndex + Len(match.Value)) rng.Text = content ' 将匹配部分替换为纯内容 Set rng = doc.Range(Start:=match.FirstIndex, _ End:=match.FirstIndex + Len(content)) ' 重建区域 ' 在区域中使用拼音向导 rng.PhoneticGuide Text:=phonetic, Alignment:= _ wdPhoneticGuideAlignmentOneTwoOne, Raise:=13, FontSize:=7 Next i End If On Error GoTo 0 MsgBox "Done!" Application.ScreenUpdating = True End Sub

下面的宏实现上面的宏的逆转换（将Word拼音指南转换为ruby标签）：

Sub ConvertPhoneticToRuby() Dim doc As Document Dim fld As Field Dim regEx As RegExp Dim m As match Dim baseChar As String, phonetic As String Dim rng As Range Application.ScreenUpdating = False Set doc = ActiveDocument Set regEx = New RegExp regEx.Global = False regEx.IgnoreCase = True '拼音域代码（保存在Field.Code.Text中）示例（Word2016）： 'EQ \* jc2 \* "Font:霞鹜文楷 GB 融合" \* hps14 \o\ad(\s\up 13(zhǒng),种) '从域代码的结尾部分捕获域代码中的拼音和汉字，正则表达式最短只需要\((.+?)\),(.+?)， '为避免误匹配其他公式域，可以适当加长正则表达式提高精确度，并添加可能的空白提高对不 '同版本的兼容性。如未能成功捕获汉字及拼音，可输出域代码观察后修改正则表达式 regEx.Pattern = "\\o\s*\\ad\s*\(.*?\d*?\s*\((.+?)\)\s*[,;]\s*(.+?)\)" '从后向前遍历所有域，避免删除域后访问到非法索引 For i = doc.Fields.Count To 1 Step -1 Set fld = doc.Fields(i) 'Debug.Print i, ":", fld.Type, ":", fld.Code.Text '只处理EQ公式域（拼音指南就是EQ域，域类型常量名wdFieldFormula） If fld.Type = 49 Then Set m = regEx.Execute(fld.Code.Text)(0) If Not m Is Nothing Then phonetic = m.SubMatches(0) baseChar = m.SubMatches(1) '用ruby标签文本替换拼音域 Set rng = fld.Result '1.1插入ruby标签文本 rng.Text = "<ruby>" & baseChar & "<rt>" & phonetic & "</rt></ruby>" '1.2删除域 fld.Delete End If End If Next i Application.ScreenUpdating = True MsgBox "完成！拼音指南已转为ruby标签。" End Sub