-
Dec 18th, 2021, 07:31 AM
#1
Thread Starter
New Member
[Word] suggestings for optimizing my macro that uses Application.CompareDocuments
I'm a translator and I work in Word (using a CAT tool that runs in Word), and over the years I have taught myself to write macros that improve my productivity. This is one of them. I'd appreciate any advice on how to optimize/speed up/improve it.
What it does:
prints text from a first bookmark in my active document into a first txt file
prints text from a second bookmark in my active document into a second txt file
compares the two text files using Word's compare (Application.CompareDocuments) function
bakes in the revisions (additions as underlined text, deletions as strikethrough text), and adds highlighting for further visibility
pastes the result as formatted text into my active document.
It gets executed multiple times throughout my workflow, potentially with every sentence I translate. It's decently fast on my personal gaming rig at home, but markedly slower on my potato at work. I'd like to optimize it so it runs faster and smoother, even if just a little.
Some notes:
I use Word 2007.
The CompareDocuments function is inherently slow since it requires Word to open the documents, so I have a feeling that is the major bottleneck.
I'm open to using a different method than Application.CompareDocuments to obtain the formatted compared text, but I have not been able to think of one.
Code:
Sub wf_diff()
Dim doc0 As Document
Dim doc1 As Document
Dim doc2 As Document
Dim doc1file As String
Dim doc2file As String
Dim doc1Print As String
Dim doc2Print As String
Dim RngTMSource As range
Dim RngSource As range
Dim RngCompare As range
Application.ScreenUpdating = False
'---------failsafe procedures---------
If ActiveDocument.Bookmarks.Exists("WfTMSource") = False Then
'answer = MsgBox("No TM source text found!", vbQuestion + vbOKOnly)
'If answer = vbOK Then Exit Sub
GoTo oAbort
End If
On Error GoTo ErrHandler
Set doc0 = ActiveDocument
doc1file = "C:\JonsMacros\wf_diff\doc1.txt"
doc2file = "C:\JonsMacros\wf_diff\doc2.txt"
doc1Print = "C:\JonsMacros\wf_diff\doc1.txt"
doc2Print = "C:\JonsMacros\wf_diff\doc2.txt"
Set RngTMSource = doc0.Bookmarks("WfTMSource").range
Set RngSource = doc0.range(doc0.Bookmarks("WfSource").range.Start, doc0.Bookmarks("WfSource").range.End - 1)
Open doc1Print For Output As #1
Print #1, RngTMSource
Close #1
Open doc2Print For Output As #2
Print #2, RngSource
Close #2
Set doc1 = Documents.Open(doc1file, Visible:=False, Encoding:=msoEncodingJapaneseShiftJIS)
Set doc2 = Documents.Open(doc2file, Visible:=False, Encoding:=msoEncodingJapaneseShiftJIS)
Application.CompareDocuments OriginalDocument:=Documents(doc1), _
RevisedDocument:=Documents(doc2), Destination:= _
wdCompareDestinationRevised, Granularity:=wdGranularityWordLevel, _
CompareFormatting:=False, CompareCaseChanges:=True, CompareWhitespace:= _
True, CompareTables:=False, CompareHeaders:=True, CompareFootnotes:=False _
, CompareTextboxes:=False, CompareFields:=False, CompareComments:=False, _
CompareMoves:=True, RevisedAuthor:="author", IgnoreAllComparisonWarnings:= _
False
doc1.Close SaveChanges:=False
'Type and Strike + Highlights (bakes in tracked visions and highlights them for visibility)
Dim chgAdd As Word.Revision
If doc2.Revisions.count = 0 Then
'MsgBox "There are no revisions in this document", vbOKOnly
Else
doc2.TrackRevisions = False
For Each chgAdd In doc2.Revisions
If chgAdd.Type = wdRevisionDelete Then
chgAdd.range.Font.StrikeThrough = True
chgAdd.range.HighlightColorIndex = wdPink
chgAdd.Reject
ElseIf chgAdd.Type = wdRevisionInsert Then
chgAdd.range.Font.Underline = wdUnderlineSingle
chgAdd.range.HighlightColorIndex = wdBrightGreen
chgAdd.Accept
Else
chgAdd.range.HighlightColorIndex = wdBlue
chgAdd.Accept
End If
Next chgAdd
End If
'end of Type and Strike + Highlights
Set RngCompare = doc2.Paragraphs(1).range
RngCompare.End = RngCompare.End - 1
RngTMSource.FormattedText = RngCompare.FormattedText
doc2.Close SaveChanges:=False
doc0.Activate
Set doc1 = Nothing
Set doc2 = Nothing
Set doc0 = Nothing
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Description
GoTo ErrExit
ErrExit:
Set doc1 = Nothing
Set doc2 = Nothing
Set doc0 = Nothing
Application.ScreenUpdating = True
oAbort:
End Sub
-
Dec 20th, 2021, 01:52 AM
#2
Re: [Word] suggestings for optimizing my macro that uses Application.CompareDocuments
Last edited by Zvoni; Tomorrow at 31:69 PM.
----------------------------------------------------------------------------------------
One System to rule them all, One Code to find them,
One IDE to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------------------
People call me crazy because i'm jumping out of perfectly fine airplanes.
---------------------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad
-
Dec 22nd, 2021, 07:11 PM
#3
Thread Starter
New Member
Re: [Word] suggestings for optimizing my macro that uses Application.CompareDocuments
Thanks for the reply, Zvoni.
Yes, I have considered using a Diff tool, but they are designed for something slightly different than what I am trying to accomplish. The result of the comparison needs to be in a format like Word produces, with underlined and strikethrough text. Additionally, for it to edge out Word's Application.CompareDocuments, the comparison would need to be accomplished via command line (e.g., text1.txt & text2.txt in, result.rtf out), and would need to be fast. If I have to launch a separate application to obtain the comparison, it would defeat the purpose. I have yet to find a solution that would meet my needs, unfortunately.
-
Dec 23rd, 2021, 04:51 PM
#4
Re: [Word] suggestings for optimizing my macro that uses Application.CompareDocuments
As a translator I suggest you re-translate the word Suggestings to Suggestions unless you want a Christmas ring ding with it.
https://github.com/yereverluvinunclebert
Skillset: VMS,DOS,Windows Sysadmin from 1985, fault-tolerance, VaxCluster, Alpha,Sparc. DCL,QB,VBDOS- VB6,.NET, PHP,NODE.JS, Graphic Design, Project Manager, CMS, Quad Electronics. classic cars & m'bikes. Artist in water & oils. Historian.
By the power invested in me, all the threads I start are battle free zones - no arguing about the benefits of VB6 over .NET here please. Happiness must reign.
-
Dec 23rd, 2021, 06:13 PM
#5
Re: [Word] suggestings for optimizing my macro that uses Application.CompareDocuments
Hi planbattack,
Personally, I have two suggestions:
1) Learn about the With [object] ... End With blocks. Those blocks can clean up your code. But, more importantly, they can cut down on the time needed to reference properties, methods, and sub-objects of the object on which you're focusing. This is especially true when you're already referencing an object within an object. For example, your code above, reworked:
Code:
For Each chgAdd In doc2.Revisions
With chgAdd.range
If chgAdd.Type = wdRevisionDelete Then
.Font.Strikethrough = True
.HighlightColorIndex = wdPink
chgAdd.Reject
ElseIf chgAdd.Type = wdRevisionInsert Then
.Font.Underline = wdUnderlineSingle
.HighlightColorIndex = wdBrightGreen
chgAdd.Accept
Else
.HighlightColorIndex = wdBlue
chgAdd.Accept
End If
End With
Next ' I also took the reference off of this, making it a bit more like c code.
2) And this is related to my first suggestion. Where it makes sense, declare object variables and use those instead of repeatedly referencing deep into an object. To illustrate, I'll take the same piece of code and do it with an explicitly declared object variable. The benefits are basically the same as the With [object] approach. When using this approach, to get the benefits though, it's important to use early-binding (and not just declare your variables As Object). In other words, use the object's class name after the As. Example:
Code:
Dim Rng As Range
For Each chgAdd In doc2.Revisions
Set Rng = chgAdd.Range
If chgAdd.Type = wdRevisionDelete Then
Rng.Font.Strikethrough = True
Rng.HighlightColorIndex = wdPink
chgAdd.Reject
ElseIf chgAdd.Type = wdRevisionInsert Then
Rng.Font.Underline = wdUnderlineSingle
Rng.HighlightColorIndex = wdBrightGreen
chgAdd.Accept
Else
Rng.HighlightColorIndex = wdBlue
chgAdd.Accept
End If
Next ' I also took the reference off of this, making it a bit more like c code.
I frequently use both of those approaches. And, that second approach can come in particularly handy when you're digging deep into something. Here's a snippet of code out of some of my Excel VBA code. I've highlighted just a few things:
Code:
' cho (a ChartObject) and wshData (a Worksheet) come into this thing.
Dim cht As Chart
Set cht = cho.Chart
'
With wshData
'
' Get things started.
X = .Cells(FirstDataRow, XColumn) ' This should be in the chart's units.
Y = .Cells(FirstDataRow, iMeanColumn) + .Cells(FirstDataRow, iMeanColumn + SdColOffset) * SDs ' This should be in the chart's units.
NodeLeft = Xpoints(X, PointsPerUnitX, LeftOffset, UnitsMinX)
NodeTop = Ypoints(Y, PointsPerUnitY, TopOffset, UnitsMinY, ChartHeight)
Dim ffb As FreeformBuilder
Set ffb = cht.Shapes.BuildFreeform(msoEditingAuto, NodeLeft, NodeTop)
' First segment is straight.
X = .Cells(FirstDataRow + 1, XColumn) ' This should be in the chart's units.
Y = .Cells(FirstDataRow + 1, iMeanColumn) + .Cells(FirstDataRow + 1, iMeanColumn + SdColOffset) * SDs ' This should be in the chart's units.
NodeLeft = Xpoints(X, PointsPerUnitX, LeftOffset, UnitsMinX)
NodeTop = Ypoints(Y, PointsPerUnitY, TopOffset, UnitsMinY, ChartHeight)
ffb.AddNodes msoSegmentLine, msoEditingAuto, NodeLeft, NodeTop
' Curved segments.
For iRow = FirstDataRow + 2 To FirstDataRow + 49
X = .Cells(iRow, XColumn) ' This should be in the chart's units.
Y = .Cells(iRow, iMeanColumn) + .Cells(iRow, iMeanColumn + SdColOffset) * SDs ' This should be in the chart's units.
NodeLeft = Xpoints(X, PointsPerUnitX, LeftOffset, UnitsMinX)
NodeTop = Ypoints(Y, PointsPerUnitY, TopOffset, UnitsMinY, ChartHeight)
ffb.AddNodes msoSegmentLine, msoEditingAuto, NodeLeft, NodeTop
Next
' ffb is used more below this as the With block continues...
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
-
Dec 25th, 2021, 04:21 AM
#6
Re: [Word] suggestings for optimizing my macro that uses Application.CompareDocuments
i have no idea if it would be faster, but you could avoid saving textfiles and opening them again, by putting the ranges from the bookmarks into new word documents (set doc1 = documents.add) then comparing those documents
whether it is in any way beneficial to you, it could also avoid any losses of formatting etc from converting the ranges to text
as mentioned by elroy there could be considerable advantages to using a with block, but be careful using break points if you do
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Dec 31st, 2021, 02:23 AM
#7
Thread Starter
New Member
Re: [Word] suggestings for optimizing my macro that uses Application.CompareDocuments
Elroy,
Wow! Thank you for the detailed reply. You are spot on about the with...end with blocks. I never bothered using them because I didn't know how they were beneficial, but now I understand their benefit.
Your second point went a little over my head, but I'll do some research on my own to try and figure it out.
Thanks again for taking the time to explain everything in detail.
wetconn1,
That is a good idea! I'll try it out and see how it fares. Thanks
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|