请高手帮助修改程序，谢谢
时间：2010-10-02
来源：互联网
这是一个分子式自动上下标的WORD窗体文字框Text1的VBA程序，怎么改一下就能利用
Private Sub App_WindowSelectionChange(ByVal Sel As Selection)
End Sub
变成在PPT中的占位符或文本框中一输入化学式（如要文本框或占位符中一输入H2或CaOH2 其中的数字2立即变成下标）就能达到即时识别呢？我是一个化学老师，做课件急需这个，请高手帮助一下，谢谢！
'分段管理
Private Sub Text1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim n As Integer, I As Integer
Dim U$, m$, T%
'********************************************************************************************************
'利用Tab键进行输入
If KeyCode = vbKeyTab And Shift = 1 Then SendKeys "{(}" & " " & "{)}", True
If KeyCode = vbKeyTab And Shift <> 1 Then SendKeys " ", True
If KeyCode = vbKeyTab And Shift = 2 Then SendKeys "{BACKSPACE 5}", True
'使文档中的换行有效
If KeyCode = 13 And Text1.Text = "" Then
Selection.TypeParagraph
End If
'在文档中输入文字
If KeyCode = 13 And Text1.Text <> "" Then
For n = 1 To Len(Text1.Text)
If (Asc(Mid(Text1.Text, n, 1)) >= 48 And Asc(Mid(Text1.Text, n, 1)) <= 57) Then
Selection.TypeText Text:=Mid(Text1.Text, n, 1)
Else
Exit For
End If
Next n
'########################################################################################################
'从文本中循环提取字符,以作出判断进行角标和各类符号的转换
For I = n To Len(Text1.Text)
m$ = Mid(Text1.Text, I, 1)
T% = Asc(m$)
'********************************************************************************************************
'转换小数点
If m$ = "." Then
m$ = "．"
Selection.TypeText Text:=m$
GoTo LXF
End If
'转换标点符号
If m$ = "," Then
Selection.TypeText Text:="，"
GoTo LXF
End If
If m$ = ":" Then
Selection.TypeText Text:="∶"
GoTo LXF
End If
If T% = 59 Then
Selection.TypeText Text:="；"
GoTo LXF
End If
If m$ = "{" Then
Selection.TypeText Text:="?"
GoTo LXF
End If
If m$ = "}" Then
Selection.TypeText Text:="?"
GoTo LXF
End If
'********************************************************************************************************
'使回车符有效,如果输入"|"则相当于回车
If T% = 13 Then GoTo LXF
If m$ = "|" Then
Selection.TypeParagraph
GoTo LXF
End If
'********************************************************************************************************
'将"="、">"、"<"转换为全角
If Mid(Text1.Text, I, 2) = "=-" Or Mid(Text1.Text, I, 2) = "＝－" Or Mid(Text1.Text, I, 2) = "=－" Or _
Mid(Text1.Text, I, 2) = "＝-" Then
Selection.TypeText Text:="＝－"
I = I + 1
GoTo LXF
Else
If Mid(Text1.Text, I, 1) = "=" Then
Selection.TypeText Text:="＝"
GoTo LXF
End If
End If
If Mid(Text1.Text, I, 1) = ">" Then
Selection.TypeText Text:="＞"
GoTo LXF
End If
If Mid(Text1.Text, I, 1) = "<" Then
Selection.TypeText Text:="＜"
GoTo LXF
End If
'********************************************************************************************************
'将单键字体设为宋体,-24150为Asc转化的数字
If T% = -24150 Then
Selection.Font.name = "宋体"
Selection.TypeText Text:=m$
Selection.Font.name = "Times new Roman"
GoTo LXF
End If
'********************************************************************************************************
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'将出现的“OH+”或“HO+”正确输入
U$ = Mid(Text1.Text, I, 3)
If U$ = "OH+" Or U$ = "HO+" Then
Selection.Font.name = "Times New Roman"
Selection.TypeText Text:="OH＋"
I = I + 2
GoTo LXF
End If
'正确输入H2O
If Mid(Text1.Text, I, 3) = "H2O" Then
Selection.Font.name = "Times New Roman"
Selection.TypeText Text:=m$
Selection.Font.subScript = wdToggle
Selection.TypeText Text:=Mid(Text1.Text, I + 1, 1)
Selection.Font.subScript = wdToggle
Selection.Font.name = "Times New Roman"
I = I + 1
GoTo LXF
End If
U$ = Mid(Text1.Text, I, 4)
If U$ = "Mg2+" Or U$ = "Cu2+" Or U$ = "Hg2+" Or U$ = "Zn2+" Or _
U$ = "Al3+" Or U$ = "Fe3+" Or U$ = "Fe2+" Or U$ = "Mn2+" Or _
U$ = "Ba2+" Or U$ = "Ca2+" Or U$ = "Cr3+" Or _
U$ = "Sn2+" Or U$ = "Pb2+" Or U$ = "Au3+" Or _
U$ = "Mg2＋" Or U$ = "Cu2＋" Or U$ = "Hg2＋" Or U$ = "Zn2＋" Or _
U$ = "Al3＋" Or U$ = "Fe3＋" Or U$ = "Fe2＋" Or U$ = "Mn2＋" Or _
U$ = "Ba2＋" Or U$ = "Ca2＋" Or U$ = "Cr3＋" Or _
U$ = "Sn2＋" Or U$ = "Pb2＋" Or U$ = "Au3＋" Then
Selection.Font.name = "Times New Roman"
Selection.TypeText Text:=m$ + Mid(Text1.Text, I + 1, 1)
Selection.Font.Superscript = wdToggle
Selection.TypeText Text:=Mid(Text1.Text, I + 2, 2)
Selection.Font.Superscript = wdToggle
Selection.Font.name = "Times New Roman"
I = I + 3
GoTo LXF
End If
If U$ = "NH4+" Or U$ = "NH4＋" Then
Selection.Font.name = "Times New Roman"
Selection.TypeText Text:=m$ + Mid(Text1.Text, I + 1, 1)
Selection.Font.subScript = wdToggle
Selection.TypeText Text:=Mid(Text1.Text, I + 2, 1)
Selection.Font.subScript = wdToggle
Selection.Font.Superscript = wdToggle
Selection.TypeText Text:="＋"
Selection.Font.Superscript = wdToggle
Selection.Font.name = "Times New Roman"
I = I + 3
GoTo LXF
End If
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
U$ = Mid(Text1.Text, I, 3) '处理氧原子后的系数
If U$ = "O2-" Or U$ = "O3-" Or U$ = "I3-" Or U$ = "O4-" Or _
U$ = "O7-" Or U$ = "O5-" Or U$ = "O6-" Or U$ = "O8-" Or _
U$ = "O2－" Or U$ = "O3－" Or U$ = "I3－" Or U$ = "O4－" Or _
U$ = "O7－" Or U$ = "O5－" Or U$ = "O6－" Or U$ = "O8－" Then
Selection.Font.name = "Times New Roman"
Selection.TypeText Text:=m$
Selection.Font.subScript = wdToggle
Selection.TypeText Text:=Mid(Text1.Text, I + 1, 1)
Selection.Font.subScript = wdToggle
Selection.Font.Superscript = wdToggle
Selection.Font.name = "宋体"
Selection.TypeText Text:="－"
Selection.Font.Superscript = wdToggle
Selection.Font.name = "Times New Roman"
I = I + 2
GoTo LXF
End If
'转换一般情况下的阴离子
U$ = Mid(Text1.Text, I + 1, 1)
If m$ = "-" Or m$ = "－" Then
If U$ <= "0" Or U$ >= "9" Then
Selection.Font.Superscript = wdToggle
Selection.Font.name = "宋体"
Selection.TypeText Text:="－"
Selection.Font.Superscript = wdToggle
Selection.Font.name = "Times New Roman"
GoTo LXF
End If
End If
'转换一般情况下的阳离子
'???????????????????????????????????????????????????????????????????????????????????????????????????????????
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'为处理如:Fe + HNO3 = Fe(NO3)3 + NO + H2O等形式的方程为设置
U$ = Mid(Text1.Text, I + 1, 1)
If m$ = " " And (U$ = "+" Or U$ = "＋") Then
Selection.TypeText Text:=" ＋"
I = I + 1
GoTo LXF
End If
'为处理沉淀或气体后的+而设计
If (m$ = "↑" Or m$ = "↓") And (U$ = "+" Or U$ = "＋") Then
Selection.TypeText Text:=m$ + "＋"
I = I + 1
GoTo LXF
End If
'处理一般情况
If m$ = "+" Or m$ = "＋" Then
If (U$ = "+" Or U$ = "＋" Or U$ = "" Or U$ = " " Or _
(U$ <> "(" And ((U$ <= "0" Or U$ > "z"))) Or U$ = "=" Or _
U$ = "＝") And U$ <> "'" Then
Selection.Font.Superscript = wdToggle
Selection.TypeText Text:="＋"
Selection.Font.Superscript = wdToggle
Selection.Font.name = "Times New Roman"
GoTo LXF
End If
End If
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'当文本中某个字符是一个自然数时将其转换为上标或下标
If T% > 47 And T% < 58 Then
'将方程式中的大系数或数字前有空格、换行符等下列情况的数字正常输入,其中-23634为"．"的值,
U$ = Mid(Text1.Text, I - 1, 1)
If U$ = "-" Or U$ = "－" Or U$ = "+" Or U$ = "＋" Or U$ = " " Or _
Asc(U$) = 10 Or Asc(U$) = 63 Or U$ = "=" Or U$ = "＝" Or U$ = "." Or _
U$ = "/" Or Asc(U$) = -24150 Or Asc(U$) = -23634 Or (Asc(U$) < 41 Or _
Asc(U$) > 126) Or U$ = "," Or U$ = ":" Or U$ = "*" Or U$ = "~" Or U$ = "L" Or _
U$ = "<" Or U$ = ">" Or U$ = ";" Or U$ = "?" Or U$ = "|" Then
For DXS = I To Len(Text1.Text)
If (Asc(Mid(Text1.Text, DXS, 1)) >= 48 And Asc(Mid(Text1.Text, DXS, 1)) <= 57) And _
Mid(Text1.Text, DXS, 1) <> " " Then
Selection.TypeText Text:=Mid(Text1.Text, DXS, 1)
I = DXS
Else
GoTo LXF
End If
Next DXS
GoTo LXF
End If
'将满足下列条件的数字转换为角标
U$ = Mid(Text1.Text, I + 1, 1)
UU$ = Mid(Text1.Text, I - 1, 1)
If (U$ <> "-" And U$ <> "－") And (U$ <> "+" And U$ <> "＋") And _
(UU$ <> "+" And UU$ <> "＋") And (UU$ <> "=" And UU$ <> "＝") Then
Selection.Font.subScript = wdToggle
Selection.TypeText Text:=Mid(Text1.Text, I, 1)
Selection.Font.subScript = wdToggle
GoTo LXF
End If
'转换阴离子
U$ = Mid(Text1.Text, I + 1, 1)
If U$ = "-" Or U$ = "－" Then
Selection.Font.Superscript = wdToggle
Selection.TypeText Text:=Mid(Text1.Text, I, 1)
Selection.Font.name = "宋体"
Selection.TypeText Text:="－"
Selection.Font.name = "Times New Roman"
Selection.Font.Superscript = wdToggle
I = I + 1
GoTo LXF
End If
'转换阳离子
'??????????????????????????????????????????????????????????????????????????????????????????????????????????
U$ = Mid(Text1.Text, I + 1, 1)
UU$ = Mid(Text1.Text, I + 1, 2)
If (UU$ = "++") Or (UU$ = "＋＋") Or U$ = "=" Or (U$ = "+" And UU$ = "+") Or (U$ = "＋" And UU$ = "＋") Then
Selection.Font.Superscript = wdToggle
Selection.TypeText Text:=Mid(Text1.Text, I, 2)
Selection.Font.name = "Times New Roman"
Selection.Font.Superscript = wdToggle
I = I + 1
GoTo LXF
End If
U$ = Mid(Text1.Text, I + 1, 1)
UU$ = Mid(Text1.Text, I + 2, 1)
If (U$ = "+" Or U$ = "＋") And (UU$ <> "+" Or UU$ <> "＋") Then
Selection.Font.subScript = wdToggle
Selection.TypeText Text:=Mid(Text1.Text, I, 1)
Selection.Font.subScript = wdToggle
Selection.Font.name = "Times New Roman"
GoTo LXF
End If
End If
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'如果以上文本不需格式转换，则正常输入第i个字符
If Mid(Text1.Text, I, 1) = "+" Then
Selection.TypeText Text:="＋"
Else
Selection.TypeText Text:=Mid(Text1.Text, I, 1)
End If
'为满足一些特定的字符输入，防止交叉管理而实现的跳转
LXF:
Next I
Text1.Text = ""
Selection.TypeText Text:=" "
End If
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'使退格键、删除键、方向键有效:当文本为空的时候，才能删除文档中字符，否则要先删去文本中的字符
If KeyCode = 8 And Text1.Text = "" Then Selection.TypeBackspace
If KeyCode = vbKeyDelete And Text1.Text = "" Then Selection.Delete
If KeyCode = vbKeyLeft And Text1.Text = "" Then Selection.MoveLeft
If KeyCode = vbKeyRight And Text1.Text = "" Then Selection.MoveRight
If KeyCode = vbKeyUp And Text1.Text = "" Then Selection.MoveUp
If KeyCode = vbKeyDown And Text1.Text = "" Then Selection.MoveDown
If KeyCode = vbKeyHome And Text1.Text = "" Then Selection.HomeKey
If KeyCode = vbKeyEnd And Text1.Text = "" Then Selection.EndKey
End Sub
Private Sub Text1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
keyAS = KeyAscii '为P0,H0,N0等转换时设置的全局键
'将小写字母转换为大写
If KeyAscii > 64 And KeyAscii < 123 Then
char = Chr(KeyAscii)
KeyAscii = Asc((UCase(char)))
End If
'按下"\"相当输入"+"
If KeyAscii = 92 Then KeyAscii = 43
'输入||键,按Caps Lock和~
If KeyAscii = 96 Then SendKeys ChrW(8214), True
'输入"(",")"
If PubSet = True Then
If KeyAscii = 91 Then KeyAscii = 40
If KeyAscii = 93 Then KeyAscii = 41
End If
'输入℃
If KeyAscii = 64 Then SendKeys ChrW(8451), True
End Sub
Private Sub Text1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim k$, e$, EE$
'******************************************************************************************************************
'连两个大写后转换为一个小写字母
If Len(Text1.Text) - 1 > 0 Then
e$ = Right(Text1.Text, 1)
EE$ = Mid(Right(Text1.Text, 2), 1, 1)
If e$ = EE$ And Asc(e$) > 64 And Asc(e$) < 91 And Right(Text1.Text, 3) <> "COO" _
And Right(Text1.Text, 3) <> "≡CC" _
And Right(Text1.Text, 3) <> "OCC" _
And Right(Text1.Text, 3) <> "CC" Then '输入OCC和CC时不变
Text1.Text = Left(Text1.Text, Len(Text1.Text) - 2) + LCase(e$)
End If
End If
'转换正确的元素符号*************************************************************************************************
L = Len(Text1.Text)
If L = 0 Or L = Null Then L = 1
k$ = Mid(Text1.Text, L, 1)
If Len(Text1.Text) - 1 > 0 And (k$ >= "0" And k$ <= "Z") Then
k$ = Mid(Text1.Text, Len(Text1.Text) - 1, 1)
If KeyCode = 65 And (k$ = "C" Or k$ = "L" Or k$ = "N" Or k$ = "G" Or _
k$ = "B" Or k$ = "T" Or k$ = "R" Or k$ = "P") Then
Text1.Text = Mid(Text1.Text, 1, Len(Text1.Text) - 1) + "a"
End If
If KeyCode = 79 And (k$ = "M") Then
Text1.Text = Mid(Text1.Text, 1, Len(Text1.Text) - 1) + "o"
End If
If keyAS = 48 And (k$ = "C" Or k$ = "M" Or k$ = "N" Or k$ = "P" Or k$ = "H") Then
Text1.Text = Mid(Text1.Text, 1, Len(Text1.Text) - 1) + "o"
End If
End If
'******************************************************************************************************************
End Sub
[ 本帖最后由 chuhaiou 于 2010-10-2 10:27 编辑 ]
分子式.rar(16.69 KB)
Private Sub App_WindowSelectionChange(ByVal Sel As Selection)
End Sub
变成在PPT中的占位符或文本框中一输入化学式（如要文本框或占位符中一输入H2或CaOH2 其中的数字2立即变成下标）就能达到即时识别呢？我是一个化学老师，做课件急需这个，请高手帮助一下，谢谢！
'分段管理
Private Sub Text1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim n As Integer, I As Integer
Dim U$, m$, T%
'********************************************************************************************************
'利用Tab键进行输入
If KeyCode = vbKeyTab And Shift = 1 Then SendKeys "{(}" & " " & "{)}", True
If KeyCode = vbKeyTab And Shift <> 1 Then SendKeys " ", True
If KeyCode = vbKeyTab And Shift = 2 Then SendKeys "{BACKSPACE 5}", True
'使文档中的换行有效
If KeyCode = 13 And Text1.Text = "" Then
Selection.TypeParagraph
End If
'在文档中输入文字
If KeyCode = 13 And Text1.Text <> "" Then
For n = 1 To Len(Text1.Text)
If (Asc(Mid(Text1.Text, n, 1)) >= 48 And Asc(Mid(Text1.Text, n, 1)) <= 57) Then
Selection.TypeText Text:=Mid(Text1.Text, n, 1)
Else
Exit For
End If
Next n
'########################################################################################################
'从文本中循环提取字符,以作出判断进行角标和各类符号的转换
For I = n To Len(Text1.Text)
m$ = Mid(Text1.Text, I, 1)
T% = Asc(m$)
'********************************************************************************************************
'转换小数点
If m$ = "." Then
m$ = "．"
Selection.TypeText Text:=m$
GoTo LXF
End If
'转换标点符号
If m$ = "," Then
Selection.TypeText Text:="，"
GoTo LXF
End If
If m$ = ":" Then
Selection.TypeText Text:="∶"
GoTo LXF
End If
If T% = 59 Then
Selection.TypeText Text:="；"
GoTo LXF
End If
If m$ = "{" Then
Selection.TypeText Text:="?"
GoTo LXF
End If
If m$ = "}" Then
Selection.TypeText Text:="?"
GoTo LXF
End If
'********************************************************************************************************
'使回车符有效,如果输入"|"则相当于回车
If T% = 13 Then GoTo LXF
If m$ = "|" Then
Selection.TypeParagraph
GoTo LXF
End If
'********************************************************************************************************
'将"="、">"、"<"转换为全角
If Mid(Text1.Text, I, 2) = "=-" Or Mid(Text1.Text, I, 2) = "＝－" Or Mid(Text1.Text, I, 2) = "=－" Or _
Mid(Text1.Text, I, 2) = "＝-" Then
Selection.TypeText Text:="＝－"
I = I + 1
GoTo LXF
Else
If Mid(Text1.Text, I, 1) = "=" Then
Selection.TypeText Text:="＝"
GoTo LXF
End If
End If
If Mid(Text1.Text, I, 1) = ">" Then
Selection.TypeText Text:="＞"
GoTo LXF
End If
If Mid(Text1.Text, I, 1) = "<" Then
Selection.TypeText Text:="＜"
GoTo LXF
End If
'********************************************************************************************************
'将单键字体设为宋体,-24150为Asc转化的数字
If T% = -24150 Then
Selection.Font.name = "宋体"
Selection.TypeText Text:=m$
Selection.Font.name = "Times new Roman"
GoTo LXF
End If
'********************************************************************************************************
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'将出现的“OH+”或“HO+”正确输入
U$ = Mid(Text1.Text, I, 3)
If U$ = "OH+" Or U$ = "HO+" Then
Selection.Font.name = "Times New Roman"
Selection.TypeText Text:="OH＋"
I = I + 2
GoTo LXF
End If
'正确输入H2O
If Mid(Text1.Text, I, 3) = "H2O" Then
Selection.Font.name = "Times New Roman"
Selection.TypeText Text:=m$
Selection.Font.subScript = wdToggle
Selection.TypeText Text:=Mid(Text1.Text, I + 1, 1)
Selection.Font.subScript = wdToggle
Selection.Font.name = "Times New Roman"
I = I + 1
GoTo LXF
End If
U$ = Mid(Text1.Text, I, 4)
If U$ = "Mg2+" Or U$ = "Cu2+" Or U$ = "Hg2+" Or U$ = "Zn2+" Or _
U$ = "Al3+" Or U$ = "Fe3+" Or U$ = "Fe2+" Or U$ = "Mn2+" Or _
U$ = "Ba2+" Or U$ = "Ca2+" Or U$ = "Cr3+" Or _
U$ = "Sn2+" Or U$ = "Pb2+" Or U$ = "Au3+" Or _
U$ = "Mg2＋" Or U$ = "Cu2＋" Or U$ = "Hg2＋" Or U$ = "Zn2＋" Or _
U$ = "Al3＋" Or U$ = "Fe3＋" Or U$ = "Fe2＋" Or U$ = "Mn2＋" Or _
U$ = "Ba2＋" Or U$ = "Ca2＋" Or U$ = "Cr3＋" Or _
U$ = "Sn2＋" Or U$ = "Pb2＋" Or U$ = "Au3＋" Then
Selection.Font.name = "Times New Roman"
Selection.TypeText Text:=m$ + Mid(Text1.Text, I + 1, 1)
Selection.Font.Superscript = wdToggle
Selection.TypeText Text:=Mid(Text1.Text, I + 2, 2)
Selection.Font.Superscript = wdToggle
Selection.Font.name = "Times New Roman"
I = I + 3
GoTo LXF
End If
If U$ = "NH4+" Or U$ = "NH4＋" Then
Selection.Font.name = "Times New Roman"
Selection.TypeText Text:=m$ + Mid(Text1.Text, I + 1, 1)
Selection.Font.subScript = wdToggle
Selection.TypeText Text:=Mid(Text1.Text, I + 2, 1)
Selection.Font.subScript = wdToggle
Selection.Font.Superscript = wdToggle
Selection.TypeText Text:="＋"
Selection.Font.Superscript = wdToggle
Selection.Font.name = "Times New Roman"
I = I + 3
GoTo LXF
End If
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
U$ = Mid(Text1.Text, I, 3) '处理氧原子后的系数
If U$ = "O2-" Or U$ = "O3-" Or U$ = "I3-" Or U$ = "O4-" Or _
U$ = "O7-" Or U$ = "O5-" Or U$ = "O6-" Or U$ = "O8-" Or _
U$ = "O2－" Or U$ = "O3－" Or U$ = "I3－" Or U$ = "O4－" Or _
U$ = "O7－" Or U$ = "O5－" Or U$ = "O6－" Or U$ = "O8－" Then
Selection.Font.name = "Times New Roman"
Selection.TypeText Text:=m$
Selection.Font.subScript = wdToggle
Selection.TypeText Text:=Mid(Text1.Text, I + 1, 1)
Selection.Font.subScript = wdToggle
Selection.Font.Superscript = wdToggle
Selection.Font.name = "宋体"
Selection.TypeText Text:="－"
Selection.Font.Superscript = wdToggle
Selection.Font.name = "Times New Roman"
I = I + 2
GoTo LXF
End If
'转换一般情况下的阴离子
U$ = Mid(Text1.Text, I + 1, 1)
If m$ = "-" Or m$ = "－" Then
If U$ <= "0" Or U$ >= "9" Then
Selection.Font.Superscript = wdToggle
Selection.Font.name = "宋体"
Selection.TypeText Text:="－"
Selection.Font.Superscript = wdToggle
Selection.Font.name = "Times New Roman"
GoTo LXF
End If
End If
'转换一般情况下的阳离子
'???????????????????????????????????????????????????????????????????????????????????????????????????????????
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'为处理如:Fe + HNO3 = Fe(NO3)3 + NO + H2O等形式的方程为设置
U$ = Mid(Text1.Text, I + 1, 1)
If m$ = " " And (U$ = "+" Or U$ = "＋") Then
Selection.TypeText Text:=" ＋"
I = I + 1
GoTo LXF
End If
'为处理沉淀或气体后的+而设计
If (m$ = "↑" Or m$ = "↓") And (U$ = "+" Or U$ = "＋") Then
Selection.TypeText Text:=m$ + "＋"
I = I + 1
GoTo LXF
End If
'处理一般情况
If m$ = "+" Or m$ = "＋" Then
If (U$ = "+" Or U$ = "＋" Or U$ = "" Or U$ = " " Or _
(U$ <> "(" And ((U$ <= "0" Or U$ > "z"))) Or U$ = "=" Or _
U$ = "＝") And U$ <> "'" Then
Selection.Font.Superscript = wdToggle
Selection.TypeText Text:="＋"
Selection.Font.Superscript = wdToggle
Selection.Font.name = "Times New Roman"
GoTo LXF
End If
End If
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'当文本中某个字符是一个自然数时将其转换为上标或下标
If T% > 47 And T% < 58 Then
'将方程式中的大系数或数字前有空格、换行符等下列情况的数字正常输入,其中-23634为"．"的值,
U$ = Mid(Text1.Text, I - 1, 1)
If U$ = "-" Or U$ = "－" Or U$ = "+" Or U$ = "＋" Or U$ = " " Or _
Asc(U$) = 10 Or Asc(U$) = 63 Or U$ = "=" Or U$ = "＝" Or U$ = "." Or _
U$ = "/" Or Asc(U$) = -24150 Or Asc(U$) = -23634 Or (Asc(U$) < 41 Or _
Asc(U$) > 126) Or U$ = "," Or U$ = ":" Or U$ = "*" Or U$ = "~" Or U$ = "L" Or _
U$ = "<" Or U$ = ">" Or U$ = ";" Or U$ = "?" Or U$ = "|" Then
For DXS = I To Len(Text1.Text)
If (Asc(Mid(Text1.Text, DXS, 1)) >= 48 And Asc(Mid(Text1.Text, DXS, 1)) <= 57) And _
Mid(Text1.Text, DXS, 1) <> " " Then
Selection.TypeText Text:=Mid(Text1.Text, DXS, 1)
I = DXS
Else
GoTo LXF
End If
Next DXS
GoTo LXF
End If
'将满足下列条件的数字转换为角标
U$ = Mid(Text1.Text, I + 1, 1)
UU$ = Mid(Text1.Text, I - 1, 1)
If (U$ <> "-" And U$ <> "－") And (U$ <> "+" And U$ <> "＋") And _
(UU$ <> "+" And UU$ <> "＋") And (UU$ <> "=" And UU$ <> "＝") Then
Selection.Font.subScript = wdToggle
Selection.TypeText Text:=Mid(Text1.Text, I, 1)
Selection.Font.subScript = wdToggle
GoTo LXF
End If
'转换阴离子
U$ = Mid(Text1.Text, I + 1, 1)
If U$ = "-" Or U$ = "－" Then
Selection.Font.Superscript = wdToggle
Selection.TypeText Text:=Mid(Text1.Text, I, 1)
Selection.Font.name = "宋体"
Selection.TypeText Text:="－"
Selection.Font.name = "Times New Roman"
Selection.Font.Superscript = wdToggle
I = I + 1
GoTo LXF
End If
'转换阳离子
'??????????????????????????????????????????????????????????????????????????????????????????????????????????
U$ = Mid(Text1.Text, I + 1, 1)
UU$ = Mid(Text1.Text, I + 1, 2)
If (UU$ = "++") Or (UU$ = "＋＋") Or U$ = "=" Or (U$ = "+" And UU$ = "+") Or (U$ = "＋" And UU$ = "＋") Then
Selection.Font.Superscript = wdToggle
Selection.TypeText Text:=Mid(Text1.Text, I, 2)
Selection.Font.name = "Times New Roman"
Selection.Font.Superscript = wdToggle
I = I + 1
GoTo LXF
End If
U$ = Mid(Text1.Text, I + 1, 1)
UU$ = Mid(Text1.Text, I + 2, 1)
If (U$ = "+" Or U$ = "＋") And (UU$ <> "+" Or UU$ <> "＋") Then
Selection.Font.subScript = wdToggle
Selection.TypeText Text:=Mid(Text1.Text, I, 1)
Selection.Font.subScript = wdToggle
Selection.Font.name = "Times New Roman"
GoTo LXF
End If
End If
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'如果以上文本不需格式转换，则正常输入第i个字符
If Mid(Text1.Text, I, 1) = "+" Then
Selection.TypeText Text:="＋"
Else
Selection.TypeText Text:=Mid(Text1.Text, I, 1)
End If
'为满足一些特定的字符输入，防止交叉管理而实现的跳转
LXF:
Next I
Text1.Text = ""
Selection.TypeText Text:=" "
End If
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'使退格键、删除键、方向键有效:当文本为空的时候，才能删除文档中字符，否则要先删去文本中的字符
If KeyCode = 8 And Text1.Text = "" Then Selection.TypeBackspace
If KeyCode = vbKeyDelete And Text1.Text = "" Then Selection.Delete
If KeyCode = vbKeyLeft And Text1.Text = "" Then Selection.MoveLeft
If KeyCode = vbKeyRight And Text1.Text = "" Then Selection.MoveRight
If KeyCode = vbKeyUp And Text1.Text = "" Then Selection.MoveUp
If KeyCode = vbKeyDown And Text1.Text = "" Then Selection.MoveDown
If KeyCode = vbKeyHome And Text1.Text = "" Then Selection.HomeKey
If KeyCode = vbKeyEnd And Text1.Text = "" Then Selection.EndKey
End Sub
Private Sub Text1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
keyAS = KeyAscii '为P0,H0,N0等转换时设置的全局键
'将小写字母转换为大写
If KeyAscii > 64 And KeyAscii < 123 Then
char = Chr(KeyAscii)
KeyAscii = Asc((UCase(char)))
End If
'按下"\"相当输入"+"
If KeyAscii = 92 Then KeyAscii = 43
'输入||键,按Caps Lock和~
If KeyAscii = 96 Then SendKeys ChrW(8214), True
'输入"(",")"
If PubSet = True Then
If KeyAscii = 91 Then KeyAscii = 40
If KeyAscii = 93 Then KeyAscii = 41
End If
'输入℃
If KeyAscii = 64 Then SendKeys ChrW(8451), True
End Sub
Private Sub Text1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim k$, e$, EE$
'******************************************************************************************************************
'连两个大写后转换为一个小写字母
If Len(Text1.Text) - 1 > 0 Then
e$ = Right(Text1.Text, 1)
EE$ = Mid(Right(Text1.Text, 2), 1, 1)
If e$ = EE$ And Asc(e$) > 64 And Asc(e$) < 91 And Right(Text1.Text, 3) <> "COO" _
And Right(Text1.Text, 3) <> "≡CC" _
And Right(Text1.Text, 3) <> "OCC" _
And Right(Text1.Text, 3) <> "CC" Then '输入OCC和CC时不变
Text1.Text = Left(Text1.Text, Len(Text1.Text) - 2) + LCase(e$)
End If
End If
'转换正确的元素符号*************************************************************************************************
L = Len(Text1.Text)
If L = 0 Or L = Null Then L = 1
k$ = Mid(Text1.Text, L, 1)
If Len(Text1.Text) - 1 > 0 And (k$ >= "0" And k$ <= "Z") Then
k$ = Mid(Text1.Text, Len(Text1.Text) - 1, 1)
If KeyCode = 65 And (k$ = "C" Or k$ = "L" Or k$ = "N" Or k$ = "G" Or _
k$ = "B" Or k$ = "T" Or k$ = "R" Or k$ = "P") Then
Text1.Text = Mid(Text1.Text, 1, Len(Text1.Text) - 1) + "a"
End If
If KeyCode = 79 And (k$ = "M") Then
Text1.Text = Mid(Text1.Text, 1, Len(Text1.Text) - 1) + "o"
End If
If keyAS = 48 And (k$ = "C" Or k$ = "M" Or k$ = "N" Or k$ = "P" Or k$ = "H") Then
Text1.Text = Mid(Text1.Text, 1, Len(Text1.Text) - 1) + "o"
End If
End If
'******************************************************************************************************************
End Sub
[ 本帖最后由 chuhaiou 于 2010-10-2 10:27 编辑 ]
附件
分子式.rar(16.69 KB)
2010-10-2 10:27, 下载次数: 0
作者: chuhaiou 发布时间: 2010-10-02
不能移花接木？
作者: chuhaiou 发布时间: 2010-10-02
相关阅读 更多
热门阅读
-
office 2019专业增强版最新2021版激活秘钥/序列号/激活码推荐 附激活工具
阅读：74
-
如何安装mysql8.0
阅读：31
-
Word快速设置标题样式步骤详解
阅读：28
-
20+道必知必会的Vue面试题（附答案解析）
阅读：37
-
HTML如何制作表单
阅读：22
-
百词斩可以改天数吗？当然可以，4个步骤轻松修改天数！
阅读：31
-
ET文件格式和XLS格式文件之间如何转化？
阅读：24
-
react和vue的区别及优缺点是什么
阅读：121
-
支付宝人脸识别如何关闭?
阅读：21
-
腾讯微云怎么修改照片或视频备份路径?
阅读：28
