VBA for all improve Lesson 12: call WORD

Keywords: Excel

VBA operation word

Tagged digit

Requirement: mark all numbers in the word document

Sub modify word All numbers for()
t = Timer()

    Dim i As Long, c As Range, d As Document
    'Traverse all characters in the paragraph
    For i = 1 To Application.ActiveDocument.Characters.Count
    
    'Will be the first i Characters range Object assigned to c
        Set c = Application.ActiveDocument.Characters(i)
        
        If IsNumeric(c.Text) Then
        'range.value stay word Medium for range.text
        
        c.Bold = True
        c.Font.ColorIndex = wdRed
        c.Italic = True
        
        End If
    
    Next i

MsgBox "It's all in use." & Timer() - t & "second"

End Sub

Note: first, it should be written in the middle of word instead of excel
The second is to enable docm instead of docx

The work efficiency of the above code is low. It takes four minutes to process hundreds of characters in a page of documents. The specific technical optimization can't be done for the time being. Leave a pit to fill in later

In word, arrays are all one-dimensional, without the concept of rows and columns
range(3,8) starts from character No. 3 and ends before character No. 8 and starts from 0
You get 34567

Using regular expressions

Find all percentages

If the above regular expression is changed to "\ d", all the numbers can be found, which is a lot more efficient. It is not needed in a second

However, I only use the summary page of the whole paper. There is no problem, but there are many unexpected mistakes when it is extended to the full text

I directly use the above code to extend to the full text, and there are some unexpected errors. However, I copied the paragraph to the regular expression detector alone, and found that there is no problem with the expression, so I continue to leave a hole here

Sub modify word All numbers for3()
t = Timer()

    Dim s As Range, d As Document
    Dim reg As Object, mches As Object, mch As Object
    
    Set d = Application.ActiveDocument
    'd Represents the currently active document
    Set reg = CreateObject("vbscript.regexp")
    'Creating a regular expression object
    reg.Pattern = "\d"
    'number 
    
    reg.Global = True
    'call reg
    Set mches = reg.Execute(d.Range.Text)
    'Execution statement
    For Each mch In mches
        Set c = d.Range(mch.firstindex, mch.firstindex + mch.Length)
        
        c.Font.ColorIndex = wdRed

    Next mch
    'scanning
    MsgBox "It's all in use." & Timer() - t & "second"
End Sub

Generate new files for each segment

Sub Batch processing paragraph()

Dim t

t = Timer()

Dim i As Long, p As Paragraph
Dim d1 As Document, d2 As Document
    
    Set d1 = ActiveDocument
    
    i = 1
    
    For Each p In d1.Paragraphs
    'scanning d1 Each paragraph in
    
        Set d2 = Application.Documents.Add
    'Newly build word File
        d2.Range.Text = d1.Paragraphs(i).Range.Text
    'Write the section just read out d2
        d2.SaveAs "G:\Online course\Yang Yang VBA\All the people together VBA Improvement articles(Excel data processing)\Generating paragraphs\" & i & ".docx"
    'Save as new document
        d2.Close
        
        i = i + 1
    
    Next p
    
    MsgBox "It's all in use." & Timer() - t & "second"
    
End Sub

Set header

In fact, it should not be used, because it is not convenient to set various styles and miscellaneous formats here. Here is just the possibility of operation

Sub Batch header()

Dim t

t = Timer()
    
    Dim i As Long, d As Document
    
    For i = 1 To 16
    
        Set d = Application.Documents.Open("G:\Online course\Yang Yang VBA\All the people together VBA Improvement articles(Excel data processing)\Generating paragraphs\" & i & ".docx")
        'Open operation
        d.Sections(1).Headers(1).Range.Text = "Jin to black"
        'The properties of an object can be understood with a little reference when needed
        d.Save
        'Save and close operations
        d.Close
        
    Next i
    
    MsgBox "It's all in use." & Timer() - t & "second"
    
End Sub

Because it involves opening and closing, the running speed is not fast. It takes about 2 seconds for one cycle and 31 seconds for 16 files
If the file volume is too large, it still takes a lot of time

You can choose to run the program in EXCEL, which is conducive to improving work efficiency. It took 25 seconds this time

Sub Batch header()

Dim t

t = Timer()
    
    Dim i As Long, d As Object, doc As Object
    Set d = CreateObject("word.application")
    'stay excel Of vbe Intermediate introduction word
    For i = 1 To 16
    
        Set doc = d.Documents.Open("G:\Online course\Yang Yang VBA\All the people together VBA Improvement articles(Excel data processing)\Generating paragraphs\" & i & ".docx")
        'take doc Object points to open operation
        doc.Sections(1).Headers(1).Range.Text = "Brocade to heat"
       
        doc.Save
        'Save and close operations
        doc.Close
        
    Next i
    
    MsgBox "It's all in use." & Timer() - t & "second"
    
End Sub

You can also use the big killer getobject

Sub Batch header()

Dim t

t = Timer()
    
    Dim i As Long, doc As Object

    For i = 1 To 16
    
        Set doc = GetObject("G:\Online course\Yang Yang VBA\All the people together VBA Improvement articles(Excel data processing)\Generating paragraphs\" & i & ".docx")
        'take doc Object points to open operation
        doc.Sections(1).Headers(1).Range.Text = "Kam to say"
       'set doc=getobject()
       'Amount to set doc =workbooks.open
        doc.Save
        'Save and close operations
        doc.Close
        
    Next i
    
    MsgBox "It's all in use." & Timer() - t & "second"
    
End Sub

The key point is that this method will not show on and off on the screen, one is clean, the other is efficiency improvement
But it must be run according to the file corresponding to the software, and the code is the same
Same for word, run this section in EXCEL for 27 seconds
In word for 14 seconds, there's a specialty

Published 25 original articles, won praise 5, visited 1039
Private letter follow

Posted by jacobelias on Mon, 20 Jan 2020 01:41:08 -0800