excel中写vba，将word的某些规则的字符串标黄色

zz元

  您好！有人帮我把 “【】” 和里面的内容标黄，谢谢。
规则：
在excel里面使用vba来写。
把“【和里面的内容】”都标黄色
谢谢谢谢

taller

1. Option Explicit
   
2. 
   
3. Private Sub HightLight()
   
4.     Dim objWord As Object
   
5.     Dim objDoc
   
6.     Set objWord = CreateObject("Word.Application")
   
7. '    Set objWord = GetObject(, "Word.Application")
   
8.     objWord.Visible = True
   
9.     Set objDoc = objWord.Documents.Open(ThisWorkbook.Path & "\周报.docx")
   
10.     objWord.Selection.Find.ClearFormatting
    
11.     objWord.Selection.Find.Replacement.ClearFormatting
    
12.     objWord.Selection.Find.Replacement.Highlight = True
    
13.     With objWord.Selection.Find
    
14.         .Text = "【*】"
    
15.         .Replacement.Text = ""
    
16.         .Forward = True
    
17.         .Wrap = 0
    
18.         .Format = True
    
19.         .MatchCase = False
    
20.         .MatchWholeWord = False
    
21.         .MatchByte = False
    
22.         .MatchAllWordForms = False
    
23.         .MatchSoundsLike = False
    
24.         .MatchWildcards = True
    
25.     End With
    
26.     objWord.Selection.Find.Execute Replace:=2
    
27.     objDoc.Save
    
28.     objDoc.Close
    
29.     objWord.Quit
    
30.     Set objDoc = Nothing
    
31.     Set objWord = Nothing
    
32.     MsgBox "done"
    
33. End Sub
    

复制代码

taller

gwjkkkkk

Option Explicit

Sub test()
    Dim wdApp As Word.Application, Items As FileDialogSelectedItems, strPath$
   
    strPath = ThisWorkbook.Path & "\"
    With Application.FileDialog(1)
        With .Filters
            .Clear
            .Add "Word文档(doc?)", "*.doc?"
        End With
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show Then Set Items = .SelectedItems Else Exit Sub
    End With
   
    Application.ScreenUpdating = False
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If Err <> 0 Then
        Set wdApp = New Word.Application
    End If
   
    With wdApp.documents.Open(Items(1))
        With .Content.Find
            .ClearFormatting
            .Text = "【*】"
            .Forward = True
            .MatchWildcards = True
            Do While .Execute
                With .Parent
                    With wdApp.ActiveDocument.Range(.Start + 1, .End - 1)
                       .HighlightColorIndex = wdYellow ' .Font.Color = wdColorYellow
                    End With
                End With
            Loop
        End With
        .Close True
    End With
   
    If Err <> 0 Then wdApp.Quit
    Set wdApp = Nothing
    Set Items = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

................

zz元

taller 发表于 2024-8-25 00:23

谢谢谢谢，谢谢谢谢谢谢

悠扬的旋律

taller 发表于 2024-8-25 00:23

学习一下

1. Sub HightLight()
   
2.     Set WordApplication = CreateObject("Word.Application")
   
3.     WordApplication.Visible = True
   
4.     Set Document = WordApplication.Documents.Open(ThisWorkbook.Path & "\周报.docx")
   
5.     Set Find = WordApplication.Selection.Find
   
6.     Find.Replacement.Highlight = True '突出显示
   
7.     Find.Execute FindText:="【*】", MatchWildcards:=1, Replace:=2
   
8. End Sub

复制代码

悠扬的旋律

gwjkkkkk 发表于 2024-8-25 09:00
Option Explicit

Sub test()

学习一下

1. Sub test()
   
2.     Set WordApplication = CreateObject("Word.Application")
   
3.     WordApplication.Visible = True
   
4.     Set Document = WordApplication.documents.Open(ThisWorkbook.Path & "\周报.docx")
   
5.     Set Range1 = Document.Content
   
6.     Set Find = Range1.Find
   
7. 1:
   
8.     判断 = Find.Execute(FindText:="【*】", MatchWildcards:=1)
   
9.     If 判断 Then
   
10.         Set Range2 = Find.Parent
    
11.         Range2.HighlightColorIndex = 7
    
12.         GoTo 1
    
13.     End If
    
14. End Sub

复制代码