本帖最后由 fenrir 于 2019-7-19 21:44 编辑

    使用环境WORD2007，后续OFFICE版本VBA代码会有些许差异，自行修改即可。
    使用方法，在word中按ctrl+F11进入宏编辑界面，新建模块，将下述代码复制粘贴即可。
    目前功能还比较简陋，智能识别无机化学的基本元素符号，虽然无法识别酸根，但可识别简单的化合物及其下角标。
    例如:
    三氧化二铁，可替换为Fe2O3（帖子中不会弄下角标）
   二氧化硫可替换为SO2
注：
    1. 后续会更新到VB.NET上，并增加常用酸根及常用有机化合物的识别。
    2. 直接运行宏处理速度较慢，执行代码前建议先存盘，避免丢失重要数据，或被错误替换。
    3. 处理量建议限制在5000字以内，运行时间30s~60s，耐心等待就好。

    处理时间有点长，不做GIF了，直接给处理效果图：
     

[hide]sub 替换元素符号()
element_ori = Array("氦", "锂", "铍", "氖", "钠", "镁", "铝", "硅", "氯", "氩", "钙", "钪", "钛", "铬", "锰", "铁", "钴", "镍", "铜", "锌", "镓", "锗", "砷", "硒", "溴", "氪", "铷", "锶", "锆", "铌", "钼", "锝", "钌", "铑", "钯", "银", "镉", "铟", "锡", "锑", "碲", "氙", "铯", "钡", "铪", "钽", "铼", "锇", "铱", "铂", "金", "汞", "*", "铅", "铋", "钋", "砹", "氡", "钫", "镭", "磷", "硫", "氟", "碘", "氮", "硼", "氢", "钨", "碳", "氧", "钒", "钇", "钾")
element_rep = Array("He", "Li", "Be", "Ne", "Na", "Mg", "Al", "Si", "Cl", "Ar", "Ca", "Sc", "Ti", "Cr", "Mn", "Fe", "Co", "Ni", "Cu", "Zn", "Ga", "Ge", "As", "Se", "Br", "Kr", "Rb", "Sr", "Zr", "Nb", "Mo", "Tc", "Ru", "Rh", "Pd", "Ag", "Cd", "In", "Sn", "Sb", "Te", "Xe", "Cs", "Ba", "Hf", "Ta", "Re", "Os", "Ir", "Pt", "Au", "Hg", "Tl", "Pb", "Bi", "Po", "At", "Rn", "Fr", "Ra", "P", "S", "F", "I", "N", "B", "H", "W", "C", "O", "V", "Y", "K")
num = Array("", "一", "二", "三", "四", "五", "六", "七", "八", "九", "十", "十一", "十二", "十三", "十四", "十五", "十六", "十七", "十八", "十九", "二十")
Dim paracount, temp_ori, temp_rep, content_para(1000), str1, str2, str3, str4
paracount = ActiveDocument.Paragraphs.count
temp_ori = ""
temp_rep = ""
For i = 1 To paracount
    content_para(i) = ActiveDocument.Paragraphs(i).Range.Text
Next
'替换成英文化学符号   调换顺序
For i = 1 To paracount
    For j = 0 To UBound(element_rep)
        For k = 10 To 0 Step -1
        str1 = num(k) & element_ori(j) '中
        If k = 0 Then str1 = element_ori(j)
            For p = 0 To UBound(element_rep)
                For q = 10 To 0 Step -1
                str2 = num(q) & element_ori(p) '中
                If q = 0 Then str2 = element_ori(p)
                  If InStr(content_para(i), str1 & "化" & str2) <> 0 Then
                    str3 = element_rep(j) & k: If k = 0 Then str3 = element_rep(j)
                    str4 = element_rep(p) & q: If q = 0 Then str4 = element_rep(p)
                    content_para(i) = Replace(content_para(i), str1 & "化" & str2, str4 & str3)
                  End If
                Next
            Next
        Next
    Next
Next

For i = 1 To paracount
    For j = 0 To UBound(element_rep)
        content_para(i) = Replace(content_para(i), element_ori(j), element_rep(j))
    Next
Next

Selection.WholeStory
Selection.Delete
For i = 1 To paracount
Selection.TypeText Text:=content_para(i)
Next
Dim input_num
For i = 0 To UBound(element_rep)
    For j = 10 To 1 Step -1
        input_num = element_rep(i) & j
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
            With Selection.Find.Replacement.Font  '下角标
                .Superscript = False
                .Subscript = True
            End With
            With Selection.Find
            .Text = input_num
            .Replacement.Text = input_num
            .Forward = True
            .Wrap = wdFindContinue
            .MatchWildcards = False
            End With
        Selection.Find.Execute Replace:=wdReplaceAll
        Selection.HomeKey Unit:=wdStory
    Next
Next

For i = 0 To UBound(element_rep)
   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
        With Selection.Find.Replacement.Font  '下角标
            .Superscript = False
            .Subscript = False
        End With
        With Selection.Find
        .Text = element_rep(i)
        .Replacement.Text = element_rep(i)
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = False
        End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.HomeKey Unit:=wdStory
Next
end sub
[/hide]