如何实现Word根据目录文件进行批量上下标？

lhw721

单个文字的批量上下标很容量实现，不过实际工作中常常会遇见不同文字的上下标，逐一修改相当的麻烦。因为工作内容比较类似，每个项目的替换文字都差不多，最好是可以指定目录文件，让宏命令根据目录文件实现批量上下标。

word批量上下标.zip (50 KB, 下载次数: 52)

2018-11-15 16:09 上传

点击文件名下载附件

cuteword

WORD灵感百宝箱（腾讯软件中心中有下载：https://pc.qq.com/search.html#!k ... E%E5%AE%9D%E7%AE%B1）中有类似功能，需要自己设置。

wangweixiang11

64位的OFFICE用不了

cuteword

下载吧中的是最后一次更新版本，支持64位office，https://xiazai.xiazaiba.com/Soft ... .5.0_1_XiaZaiBa.zip

lhw721

谢谢cuteword，这个功能WORD灵感百宝箱是可以实现。弱水三千，我只取一瓢饮，因为软件的很多功能我这暂时用不上，还是想得到如题的按目录上下标的宏。

lhw721

word版块的人气远不如excel版块，我自个悄悄的顶一下

ming0018

Sub 批量上标test()
   
    '------------------------------------上面这部分主要是把原文字和上下标存入数组
    Dim doc As Document, rCount%, i%, n%
    Dim Str_Original() As String, Str_Superscript() As String, Str_Subscript() As String
    Set doc = ActiveDocument: n = 1
    rCount = doc.Tables(1).Rows.Count
    For i = 2 To rCount
        If doc.Tables(1).Cell(i, 1).Range.Text <> Chr(13) & Chr(7) Then
            ReDim Preserve Str_Original(1 To n)
            ReDim Preserve Str_Superscript(1 To n) '上标
            ReDim Preserve Str_Subscript(1 To n)   '下标
            Str_Original(n) = Split(doc.Tables(1).Cell(i, 1).Range.Text, Chr(13))(0)
            Str_Superscript(n) = Split(doc.Tables(1).Cell(i, 2).Range.Text, Chr(13))(0)
            Str_Subscript(n) = Split(doc.Tables(1).Cell(i, 3).Range.Text, Chr(13))(0)
            Debug.Print "原文字：" & Str_Original(n) & "，" & "上标：" & Str_Superscript(n) & "，" & "下标：" & Str_Subscript(n)
            n = n + 1
        End If
    Next i
   
    '------------------------------------下面这部分主要遍历组数，用查找替换的方式分别对字符串上下标
    Dim Str_Start&, Str_End&, Rng As Range
    For i = 1 To UBound(Str_Original)
        With doc.Content.Find
            .Text = Str_Original(i)
            Do While .Execute
                Str_Start = .Parent.Start: Str_End = .Parent.End
                If Str_Superscript(i) <> "" Then
                    Set Rng = doc.Range(Str_Start, Str_End)
                    With Rng.Find
                        .Text = Str_Superscript(i)
                        .Replacement.Font.Superscript = True
                        .Execute Replace:=wdReplaceAll
                    End With
                End If
                If Str_Subscript(i) <> "" Then
                    Set Rng = doc.Range(Str_Start, Str_End)
                    With Rng.Find
                        .Text = Str_Subscript(i)
                        .Replacement.Font.Subscript = True
                        .Execute Replace:=wdReplaceAll
                    End With
                End If
            Loop
        End With
    Next i
End Sub


想要指定或者批量对文件操作的话，自己改吧。

ming0018

原文字        上标        下标        替换文字
γ52(3)c        2(3)c        5        γ52(3)c
Jcr                cr        Jcr
Q4s        s        4        Q4s
Q4dl        dl        4        Q4dl
MPa-1        -1                MPa-1
10-1cm/s        -1                10-1cm/s
10-2cm/s        -2                10-2cm/s


这个表 可以放在excel上 用ado+sql来做。

lhw721

ming0018 发表于 2018-11-26 11:32
原文字        上标        下标        替换文字
γ52(3)c        2(3)c        5        γ52(3)c
Jcr  ...

谢谢ming0018的回复，“批量上标test”这个宏仅能实现在“Word批量上下标目录表”下对文字进行上下标，我是想根据“Word批量上下标目录表”来对“案例”文件进行上下标，有办法实现吗？

loquat

http://club.excelhome.net/forum. ... 324&pid=9730338
http://club.excelhome.net/thread-1319867-4-1.html