Word中很多化学分子式，如何一次性将数字替换为下标？

H2SO4，NaSiO3，44343，H2O2，3%
举例如上，非化学式数字不替换。
谢谢了。

请参考下面的代码:
Sub 批量处理化学分子式()
Dim myRange As Range, myend As Long
'如果没有选定区域则作全文档处理
Set myRange = IIf(Selection.Type = wdSelectionIP, ActiveDocument.Content, Selection.Range)
myend = myRange.End  '取得待区域的结束位置
With myRange.Find
    .ClearFormatting '清除查找框格式
    .Replacement.ClearFormatting '清除替换框格式
    .MatchWildcards = False '不勾选“使用通配符”
    .Text = "^$^#"   '查找由（前）字母和（后）数字构成的内容
    .Replacement.Text = ""
    .Replacement.Font.Subscript = True '设置为下标形式
    .Execute Replace:=wdReplaceAll
    .ClearFormatting '清除查找框格式
    .Replacement.ClearFormatting '清除替换框格式
    .MatchWildcards = False  '不勾选“使用通配符”
    .Text = "^$"  '查找所有字母
    .Font.Subscript = True '查找所有下标形式（即查找所有下标形式的字母）
    .Replacement.Text = ""
    .Replacement.Font.Superscript = False  '设置为非上标形式
    .Replacement.Font.Subscript = False  '设置为非下标形式
    .Execute Replace:=wdReplaceAll
End With
End Sub

谢谢，一定要用VBA吗？我试了下两次替换可以解决。一次替换行吗？不用VBA。

呵呵，看了下楼上的代码就是用我的两次替换方法实现的。先把字母和数字替换为下标，再把下标字母替换回去。希望能有一步解决的办法。还是谢谢tangqingfu。

一次可能是不行吧,如果有,我也想知道!
用代码的好处是,一次成形,多次使用,提高效率!

福建龙岩
挖，还是老乡。太感动了。

可以用二次查找的方式。即先查找分子式，但在所查找到的范围内查找数字，再进行格式设定。

[ 本帖最后由 yc310224 于 2009-5-19 20:03 编辑 ]

哈哈，学习宏代码

象这种情况:Al2(SO4)3怎么办呢?

Sub 智能上下标()
Dim x, Y, j, k As Integer
Dim m, n As Long
Dim char As String
x = Selection.Start
Y = Selection.End
For j = x To Y Step 1
Selection.Start = j - 1
Selection.End = j
char = Selection.Text
n = InStr("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ))]", char)
If n <> 0 Then
Selection.Start = j
Selection.End = j + 1
char = Selection.Text
m = InStr("0123456789", char)
If m <> 0 Then
k = 2
Selection.Font.subScript = wdToggle
Selection.Start = j
Selection.End = j + k
char = Selection.Characters(k).Text
m = InStr("0123456789-+", char)
Do While m <> 0
If char = "+" Or char = "-" Then
Selection.Start = j + k
Selection.End = j + k + 1
char = Selection.Text
m = InStr("0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ(([", char)
If m <> 0 Then
    GoTo LINE1
   Else
Selection.Start = j - 1
Selection.End = j + k
char = Selection.Characters(1).Text
End If
If char = "O" Or char = "H" Then '与line1共同作用以防止将NH4+、AlO2-
Selection.Start = j
Selection.End = j + 1
Selection.Font.subScript = wdToggle
Selection.Font.subScript = wdToggle
Selection.Start = j + 1
Selection.End = j + k
Selection.Font.Superscript = wdToggle
GoTo LINE1
End If
Selection.Start = j
Selection.End = j + k
Selection.Font.Superscript = wdToggle
Selection.Font.Superscript = wdToggle
GoTo LINE1
End If
k = k + 1
Selection.Start = j
Selection.End = j + k
char = Selection.Characters(k).Text
If char = "-" Or char = "+" Then
Selection.Start = j
Selection.End = j + k - 2
Selection.Font.subScript = wdToggle
Selection.Font.subScript = wdToggle
Selection.Start = j + k - 2
Selection.End = j + k
Selection.Font.Superscript = wdToggle
GoTo LINE1
Else
m = InStr("0123456789", char)
End If
Loop
Selection.Start = j
Selection.End = j + k - 1
Selection.Font.subScript = wdToggle
Selection.Font.subScript = wdToggle
End If
LINE1:
Selection.Start = j
Selection.End = j + 1
char = Selection.Text
m = InStr("-", char)
If m <> 0 Then
Selection.Start = j + 1
Selection.End = j + 2
char = Selection.Text
m = InStr("0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ(([", char)
If m = 0 Then
Selection.Start = j
Selection.End = j + 1
Selection.Font.Superscript = wdToggle
End If
End If
m = InStr("+", char)
If m <> 0 Then
Selection.Start = j + 1
Selection.End = j + 2
char = Selection.Text
m = InStr("0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ(([+", char)
If m = 0 Then
Selection.Start = j
Selection.End = j + 1
Selection.Font.Superscript = wdToggle
End If
End If
End If
Next j
Selection.Start = Y
Selection.End = Y
End Sub

这段代码很好很强大，有一个问题请教一下，能不能排除某些特定词组不被替换？

学习一下，高手很多

谢谢chuhaiou兄的代码！
收藏备用！