VB操作WORD更改字体格式问题 50
现在从一个文本文件中读出11/2"字符把这个字符给STRING类型FindText变量中,然后打开一个WORD文件用:AppWord.Selection.Find.Exe...
现在从一个文本文件中读出 1 1/2" 字符 把这个字符给STRING类型 FindText 变量中,然后打开一个WORD文件用:
AppWord.Selection.Find.Execute FindText:=FindTexts, Forward:=True '从当前位置开始向前寻找文字"实际"
If AppWord.Selection.Range.ComputeStatistics(wdStatisticCharactersWithSpaces) = Len(FindTexts) Then
但就是不能正确的找到字符并替换格式,WORD文件中是有1 1/2"这个字符的,
然后把 11 /2" 直接换成 / 就可以替换, 然后再换成 12 也可以替换, 但是将1 1/2"放进去就替换不了了,源代码如下:
Private Sub Command1_Click()
Dim YesNo As String
Dim FindTexts As String
Dim ReplaceText As String
Dim a, b, c, d As String
Dim InStr As Integer
Dim s() As String
Dim i As Integer
Dim AppWord As Word.Application
Set AppWord = CreateObject("Word.Application") '实例化Word对象
AppWord.Visible = False '使得Word对象对象不可见
AppWord.Documents.Open FileName:=App.Path & "\" & Trim(Text1.Text) '打开已经存在的Word文档
Open App.Path & "\替换文字.txt" For Input As #1
Line Input #1, ReplaceText
Do While Not EOF(1)
Line Input #1, ReplaceText
s = Split(ReplaceText, "&")
FindTexts = s(0)
YesNo = "1"
Do While YesNo = "1"
AppWord.Selection.Find.Execute FindText:=FindTexts, Forward:=True '从当前位置开始向前寻找文字"实际"
If AppWord.Selection.Range.ComputeStatistics(wdStatisticCharactersWithSpaces) = Len(FindTexts) Then
For i = 0 To UBound(s)
If s(i) = "黄色" Then
AppWord.Selection.Font.Shading.BackgroundPatternColor = wdColorYellow
End If '底纹
If s(i) = "加粗" Then
AppWord.Selection.Font.Bold = True
End If '加粗
If s(i) = "倾斜" Then
AppWord.Selection.Font.Italic = True
End If '倾斜
If s(i) = "红字" Then
AppWord.Selection.Font.Color = wdColorRed
End If '红字
Next
Selection.MoveRight Unit:=wdCharacter, Count:=Len(FindTexts) '向前移动2个字符,便于下一次寻找
Else
YesNo = "0"
End If
Loop
Selection.MoveLeft Unit:=wdCharacter, Count:=200000 '向前移动2个字符,便于下一次寻找
Erase s()
Loop
Close #1
Selection.MoveLeft Unit:=wdCharacter, Count:=200000 '向前移动2个字符,便于下一次寻找
YesNo = "1"
Do While YesNo = "1"
AppWord.Selection.Find.Execute FindText:="/", Forward:=True '从当前位置开始向前寻找文字"实际"
If AppWord.Selection.Range.ComputeStatistics(wdStatisticCharactersWithSpaces) = Len(FindTexts) Then
AppWord.Selection.Font.Shading.BackgroundPatternColor = wdColorYellow
AppWord.Selection.Font.Bold = True
AppWord.Selection.Font.Color = wdColorRed
Selection.MoveRight Unit:=wdCharacter, Count:=1 '向前移动2个字符,便于下一次寻找
Else
YesNo = "0"
End If
Loop
AppWord.Documents.Close True '保存原始文件的修改
AppWord.Quit '关闭Word
Set AppWord = Nothing '释放资源
End Sub 展开
AppWord.Selection.Find.Execute FindText:=FindTexts, Forward:=True '从当前位置开始向前寻找文字"实际"
If AppWord.Selection.Range.ComputeStatistics(wdStatisticCharactersWithSpaces) = Len(FindTexts) Then
但就是不能正确的找到字符并替换格式,WORD文件中是有1 1/2"这个字符的,
然后把 11 /2" 直接换成 / 就可以替换, 然后再换成 12 也可以替换, 但是将1 1/2"放进去就替换不了了,源代码如下:
Private Sub Command1_Click()
Dim YesNo As String
Dim FindTexts As String
Dim ReplaceText As String
Dim a, b, c, d As String
Dim InStr As Integer
Dim s() As String
Dim i As Integer
Dim AppWord As Word.Application
Set AppWord = CreateObject("Word.Application") '实例化Word对象
AppWord.Visible = False '使得Word对象对象不可见
AppWord.Documents.Open FileName:=App.Path & "\" & Trim(Text1.Text) '打开已经存在的Word文档
Open App.Path & "\替换文字.txt" For Input As #1
Line Input #1, ReplaceText
Do While Not EOF(1)
Line Input #1, ReplaceText
s = Split(ReplaceText, "&")
FindTexts = s(0)
YesNo = "1"
Do While YesNo = "1"
AppWord.Selection.Find.Execute FindText:=FindTexts, Forward:=True '从当前位置开始向前寻找文字"实际"
If AppWord.Selection.Range.ComputeStatistics(wdStatisticCharactersWithSpaces) = Len(FindTexts) Then
For i = 0 To UBound(s)
If s(i) = "黄色" Then
AppWord.Selection.Font.Shading.BackgroundPatternColor = wdColorYellow
End If '底纹
If s(i) = "加粗" Then
AppWord.Selection.Font.Bold = True
End If '加粗
If s(i) = "倾斜" Then
AppWord.Selection.Font.Italic = True
End If '倾斜
If s(i) = "红字" Then
AppWord.Selection.Font.Color = wdColorRed
End If '红字
Next
Selection.MoveRight Unit:=wdCharacter, Count:=Len(FindTexts) '向前移动2个字符,便于下一次寻找
Else
YesNo = "0"
End If
Loop
Selection.MoveLeft Unit:=wdCharacter, Count:=200000 '向前移动2个字符,便于下一次寻找
Erase s()
Loop
Close #1
Selection.MoveLeft Unit:=wdCharacter, Count:=200000 '向前移动2个字符,便于下一次寻找
YesNo = "1"
Do While YesNo = "1"
AppWord.Selection.Find.Execute FindText:="/", Forward:=True '从当前位置开始向前寻找文字"实际"
If AppWord.Selection.Range.ComputeStatistics(wdStatisticCharactersWithSpaces) = Len(FindTexts) Then
AppWord.Selection.Font.Shading.BackgroundPatternColor = wdColorYellow
AppWord.Selection.Font.Bold = True
AppWord.Selection.Font.Color = wdColorRed
Selection.MoveRight Unit:=wdCharacter, Count:=1 '向前移动2个字符,便于下一次寻找
Else
YesNo = "0"
End If
Loop
AppWord.Documents.Close True '保存原始文件的修改
AppWord.Quit '关闭Word
Set AppWord = Nothing '释放资源
End Sub 展开
3个回答
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询