设置上标 m2 m3（宏）

413191246se

* 如果未选则全选！（=如果未选定文字，则全选文档内容）

1. Sub 设置上标m2m3()
   
2.     If Selection.Type = wdSelectionIP Then Selection.WholeStory
   
3.     Dim r As Range, i As Long, j As Long
   
4.     Set r = Selection.Range
   
5.     Do
   
6.         Selection.Find.ClearFormatting
   
7.         Selection.Find.Execute findtext:="m2"
   
8.         If Selection.Find.Found = True Then
   
9.             Selection.Characters.Last.InsertBefore Text:="`"
   
10.             Selection.Characters.Last.Font.Superscript = True
    
11.             i = i + 1
    
12.         End If
    
13.         r.Select
    
14.     Loop Until Selection.Find.Found = False
    
15.     Do
    
16.         Selection.Find.ClearFormatting
    
17.         Selection.Find.Execute findtext:="m3"
    
18.         If Selection.Find.Found = True Then
    
19.             Selection.Characters.Last.InsertBefore Text:="`"
    
20.             Selection.Characters.Last.Font.Superscript = True
    
21.             j = j + 1
    
22.         End If
    
23.         r.Select
    
24.     Loop Until Selection.Find.Found = False
    
25.     Selection.Find.Execute findtext:="`", ReplaceWith:="", Replace:=wdReplaceAll
    
26.     MsgBox "处理完毕！（共处理 " & i & " 个 m2，" & j & " 个 m3）", vbOKOnly + vbExclamation, "设置上标"
    
27. End Sub

复制代码

13907933959

师傅好！
怎样替换下标数字呢？
如文字中有大量H2，需要替换2为下标。

loquat

以前写的代码，很明显有点Low

1. Public Sub 设置上下标(ByVal 查找字串$, ByVal 修改字串$, Optional ByVal 模式 As String = "上标")
   
2. '调用方式：例如，要将全文的m3/s中的3设置为上标
   
3. 'Call 设置上下标("m3/s","3","上标")
   
4. Application.ScreenUpdating = False
   
5.     Dim aDoc As Document: Set aDoc = ActiveDocument
   
6.     Dim aRange As Range, a%, b%
   
7.     a = InStr(1, 查找字串, 修改字串)
   
8.     b = Len(修改字串)
   
9.     With Selection
   
10.         .HomeKey wdStory
    
11.         .Find.Text = 查找字串
    
12.         Do While .Find.Execute
    
13.             Set aRange = Selection.Range
    
14.             aRange.SetRange aRange.Start + a - 1, aRange.Start + a + b - 1
    
15.             aRange.Editors.Add wdEditorEveryone
    
16.         Loop
    
17.     End With
    
18.     aDoc.SelectAllEditableRanges wdEditorEveryone
    
19.     aDoc.DeleteAllEditableRanges wdEditorEveryone
    
20.     If 模式 = "上标" Then
    
21.         Selection.Font.Superscript = True
    
22.     ElseIf 模式 = "下标" Then
    
23.         Selection.Font.Subscript = True
    
24.     End If
    
25. Application.ScreenUpdating = True
    
26. End Sub
    
27. 
    
28. Sub 执行()
    
29. 设置上下标 "m2", "2", "上标"
    
30. 设置上下标 "m3", "3", "上标"
    
31. End Sub

复制代码

13907933959

loquat 发表于 2015-11-1 21:51
以前写的代码，很明显有点Low

前辈好！
怎样设置下标数字呢？
如文字中有大量H2，需要设置2为下标。

413191246se

139：上标是查找m2/m3，下标是H2，录制宏看看下标的定义是怎么样的，再在上面的代码上面一改就OK了！-------loquat 朋友代码太高级！看不懂！建议别来函数，来过程Sub。
Sub 设置下标H2()
    If Selection.Type = wdSelectionIP Then Selection.WholeStory
    Dim r As Range, i As Long
    Set r = Selection.Range
    Do
        Selection.Find.ClearFormatting
        Selection.Find.Execute findtext:="H2"
        If Selection.Find.Found = True Then
            Selection.Characters.Last.InsertBefore Text:="`"
            Selection.Characters.Last.Font.Subscript = True
            i = i + 1
        End If
        r.Select
    Loop Until Selection.Find.Found = False
    Selection.Find.Execute findtext:="`", ReplaceWith:="", Replace:=wdReplaceAll
    MsgBox "处理完毕！（共处理 " & i & " 个 H2）", vbOKOnly + vbExclamation, "设置下标"
End Sub

13907933959

413191246se 发表于 2015-11-2 09:26
139：上标是查找m2/m3，下标是H2，录制宏看看下标的定义是怎么样的，再在上面的代码上面一改就OK了！------ ...

拜谢师傅！

loquat

设置上下标 "H2", "2", "下标"

413191246se

loquat 辛苦，但对你的代码只能无视了，因为根本不懂函数，建议来过程（Sub）。

13907933959

loquat 发表于 2015-11-2 16:07
设置上下标 "H2", "2", "下标"

谢谢前辈！

loquat

413191246se 发表于 2015-11-2 16:14
loquat 辛苦，但对你的代码只能无视了，因为根本不懂函数，建议来过程（Sub）。

传参的话，使用起来更灵活，将功能模块化利于代码扩展
例如首楼的代码这样写就很方便：sub 设置上下标(byval arr(), byval brr(), subscript() as boolean)

执行的时候，可以传入数组arr = array("m2","m3"), brr = array(2,3), subscript = array(true, true)
可以一个代码执行多个操作，代码大大简洁

我能体会到的也就这点好处，其他的没啥体会