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

ming0018 · 发表于 2018-11-27 09:25

lhw721 发表于 2018-11-27 08:34
谢谢ming0018的回复，“批量上标test”这个宏仅能实现在“Word批量上下标目录表”下对文字进行上下标，我 ...

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

lhw721 · 发表于 2018-11-27 11:05

ming0018 发表于 2018-11-27 09:25
这个表可以放在excel上用ado+sql来做。

可以帮我吗？我实在搞不定，万分感谢！

ming0018 · 发表于 2018-11-27 11:30

lhw721 发表于 2018-11-27 11:05
可以帮我吗？我实在搞不定，万分感谢！

发一个测试文档我，我下午有空给你搞一个。

lhw721 · 发表于 2018-11-28 09:17

ming0018 发表于 2018-11-27 11:30
发一个测试文档我，我下午有空给你搞一个。

案例.zip (41.15 KB, 下载次数: 16)
“目录”在一楼的附件，就是根据目录上的替换要求，批量替换“案例”上的文字。

ming0018 · 发表于 2018-11-28 11:06

lhw721 发表于 2018-11-28 09:17
“目录”在一楼的附件，就是根据目录上的替换要求，批量替换“案例”上的文字。

请看一下附件是否是您要的效果。

lhw721 · 发表于 2018-11-28 17:30

ming0018 发表于 2018-11-28 11:06
请看一下附件是否是您要的效果。

是的，就是要这个效果，不过文字可以不要加颜色，另外表格里有10-2（-2是上标）好像没有处理到

ming0018 · 发表于 2018-11-29 08:39

lhw721 发表于 2018-11-28 17:30
是的，就是要这个效果，不过文字可以不要加颜色，另外表格里有10-2（-2是上标）好像没有处理到

表格里的10-2和 ”Word批量上下标目录表“ 不一样，多了一个空格，所以无法处理。

wdpfox · 发表于 2018-11-29 09:00

正需要，下载试用，感谢老师无私分享！

wdpfox · 发表于 2018-11-29 15:29

ming0018 发表于 2018-11-26 10:55
Sub 批量上标test()

'------------------------------------上面这部分主要是把原文字和上下标 ...

如果有两个要用下标的如何处理？如：KAl(SO4)2，4和2都要下标格式。

ming0018 · 发表于 2018-11-29 16:14

wdpfox 发表于 2018-11-29 15:29
如果有两个要用下标的如何处理？如：KAl(SO4)2，4和2都要下标格式。

Sub 批量上标test()
'------------------------------------上面这部分主要是把原文字和上下标存入数组
Dim doc As Document, rCount%, i%, j%, n%
Dim Str_Original() As String, Str_Superscript() As String, Str_Subscript() As String
Set doc = ActiveDocument: n = 1
ReDim Preserve Str_Original(1 To n)
ReDim Preserve Str_Superscript(1 To n) '上标
ReDim Preserve Str_Subscript(1 To n) '下标
Str_Original(1) = "KAl(SO4)2": Str_Superscript(1) = "AL": Str_Subscript(1) = "4,2" '下标不同时用逗号隔开
'Str_Original(2) = "KAl(SO4)2": Str_Superscript(2) = "AL": Str_Subscript(2) = "4,2"
'Str_Original(3) = "KAl(SO4)2": Str_Superscript(3) = "AL": Str_Subscript(3) = "4,2"
'如果少的话，可以自己往后加
'------------------------------------下面这部分主要遍历组数，用查找替换的方式分别对字符串上下标
Dim Str_Start&, Str_End&, Rng As Range, Str_Superscript_Arr() As String, Str_Subscript_Arr() As String
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
Str_Superscript_Arr = Split(Str_Superscript(i), ",")
For j = 0 To UBound(Str_Superscript_Arr)
Set Rng = doc.Range(Str_Start, Str_End)
With Rng.Find
.Text = Str_Superscript_Arr(j)
.Replacement.Font.Superscript = True
.Execute Replace:=wdReplaceAll
End With
Next j
End If
If Str_Subscript(i) <> "" Then
Str_Subscript_Arr = Split(Str_Subscript(i), ",")
For j = 0 To UBound(Str_Subscript_Arr)
Set Rng = doc.Range(Str_Start, Str_End)
With Rng.Find
.Text = Str_Subscript_Arr(j)
.Replacement.Font.Subscript = True
.Execute Replace:=wdReplaceAll
End With
Next j
End If
Loop
End With
Next i
End Sub

复制代码

		自动登录	找回密码
密码			免费注册

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

评分