如何通过Excel的vba将word中的指定位置的数字设置上标

batmanbbs · 发表于 2023-7-1 16:54

本帖最后由 batmanbbs 于 2023-7-1 17:08 编辑

嗯，WPS下直接做不到，但是可以采用折中的方法，但是很麻烦，而且还存在和WORD的兼容性。
PS：你在标题和一楼也没有说是WPS啊

叮盯当 · 发表于 2023-7-1 18:02

batmanbbs 发表于 2023-7-1 16:54
嗯，WPS下直接做不到，但是可以采用折中的方法，但是很麻烦，而且还存在和WORD的兼容性。
PS：你在标题和 ...

不知道你的折中的方法是什么，看你删除多一行的内容启发，我也折中了一个，先按1列的方式粘贴过来，再定位需要上标的数字
With .cell(i, 2).Range
      x = Application.Find("×10", .Text)
      While IsNumeric(.Characters(x + 3))
      .Characters(x + 3).Font.Superscript = True
      x = x + 1
      Wend
End With

batmanbbs · 发表于 2023-7-2 09:22

叮盯当发表于 2023-7-1 18:02
不知道你的折中的方法是什么，看你删除多一行的内容启发，我也折中了一个，先按1列的方式粘贴过来，再定 ...

这样很好。因为COPY和PASTE两个方法执行时需要时间，非常不保靠，一般需要加入延时才可以。所以直接赋值的方法是最好的，然后再根据实际需求修改格式。

batmanbbs · 发表于 2023-7-2 09:50

叮盯当发表于 2023-7-1 18:02
不知道你的折中的方法是什么，看你删除多一行的内容启发，我也折中了一个，先按1列的方式粘贴过来，再定 ...

Sub 带格式复制单元格内容到WORD文档()
'
' For WORD/WPS：赋值后再修改上标
'
Dim myWord, myDoc As Object
Dim pos%
Set myWord = CreateObject("Word.Application")
myWord.Visible = True
Set myDoc = myWord.Documents.Open(ThisWorkbook.Path & "\1.doc")
With myDoc.Tables(1)
For i = 2 To 5
.Cell(i, 1).Range.Text = Cells(i, 1)
.Cell(i, 2).Range.Text = Cells(i, 2)
With .Cell(i, 2).Range
pos = InStr(.Text, "×10") + 3
If pos > 3 Then
While IsNumeric(.Characters(pos))
.Characters(pos).Font.Superscript = True
pos = pos + 1
Wend
End If
End With
Next
End With
Set myDoc = Nothing
Set myWord = Nothing
End Sub

复制代码

叮盯当 · 发表于 2023-7-3 11:54

batmanbbs 发表于 2023-7-2 09:50

一个格子里有多处就不好用了，应该还是要正则表达式来更方便，可惜还不会

batmanbbs · 发表于 2023-7-3 13:28

本帖最后由 batmanbbs 于 2023-7-3 13:33 编辑

叮盯当发表于 2023-7-3 11:54
一个格子里有多处就不好用了，应该还是要正则表达式来更方便，可惜还不会

需要你的公式才行，肯定是X10后面2位数字吗？
PS：不一定用正则，用WORD自带的查找替换也行，主要还是看公式及其位置。而且如果这样操作，还不如在WORD中打开EXCEL复制粘贴，因为更多的操作是在WORD中进行的。

batmanbbs · 发表于 2023-7-3 14:08

叮盯当发表于 2023-7-3 11:54
一个格子里有多处就不好用了，应该还是要正则表达式来更方便，可惜还不会

代码是X10[1-2位数字上标]，自己可以酌情修改

Sub 复制EXCEL单元格内容到WORD文档()
'
' For WORD/WPS：赋值后再修改上标
'
Dim myWord, myDoc As Object
Dim pos%
Set myWord = CreateObject("Word.Application")
myWord.Visible = True
Set myDoc = myWord.Documents.Open(ThisWorkbook.Path & "\1.doc")
With myDoc.Tables(1)
For i = 2 To 5
.Cell(i, 1).Range.Text = Cells(i, 1)
.Cell(i, 2).Range.Text = Cells(i, 2)
Next
With .Range.Find
.ClearFormatting
.Text = "×10[0-9]{1,2}"
.Wrap = wdFindStop
.Forward = True
.MatchWildcards = True
Do While .Execute
rStart = .Parent.Start + 3
rEnd = .Parent.End
myDoc.Range(rStart, rEnd).Font.Superscript = True
Loop
End With
End With
Set myDoc = Nothing
Set myWord = Nothing
End Sub

复制代码

叮盯当 · 发表于 2023-7-4 21:05

batmanbbs 发表于 2023-7-3 14:08
代码是X10[1-2位数字上标]，自己可以酌情修改

Excel表格里的能搞吗

batmanbbs · 发表于 2023-7-4 21:18

叮盯当发表于 2023-7-4 21:05
Excel表格里的能搞吗

对EXCEL不熟啊，你怎么不去EXCEL专版提问啊^_^

叮盯当 · 发表于 2023-7-4 21:43

batmanbbs 发表于 2023-7-4 21:18
对EXCEL不熟啊，你怎么不去EXCEL专版提问啊^_^

突然联想到的，之前表格里的都是分散录入的数据，对每次录入来说设置上标的操作不多

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

[求助] 如何通过Excel的vba将word中的指定位置的数字设置上标