Word 2010 "Change Bars" Macro

[Intern1]

Hello all, I am new to this forum. A quick introduction of what I'm trying to do, and why:

I am working for a defense contractor, and the gov't requires that the nth revision of documents have 'change bars' of at least 3pt (we ended up going with 6) to mark revisions, in the margins, from the previous version of the document.

Of course, Word does this automatically.. except with a 'change bar' that is well below 3pt in thickness. Yes, unfortunately, we MUST meet this 3pt requirement.

So, I'm setting out to figure out how to code a macro to handle this, since it appears that the super-thin change line Word does is hardcoded. I have very limited background in programming, but I'm doing my best. I found a very brief outline of an idea on this topic on another forum, and I took it and ran with it to see if I could address its gaps and shortcomings (e.g., making the change bars be on the same side of the page as page numbers, which alternate in our documents).

The biggest issue I have with this is that on some documents, it will draw things perfectly. On others, it will draw nothing at all. On some, it will draw a line down a whole page when I know for a fact that there are only revisions on a single line on it (as in just a single insert/delete in-line change). I suspect it has something to do with the way I'm defining my vertical start/stop draw positions, but I don't know. Again, this is quite unfamiliar to me, and I've had some trouble finding information I want on the VBA library, when it comes to understanding how some objects/properties/methods fit together.

The general English version in my head right now is:

1) Go through every revision in the document (these changes will be yet-to-be-accepted at the time we insert the change bars)
2) For each revision, determine if it is a visible change we want to have a change bar for (i.e. is it an insert/delete... I'll get to others later on)
3) For each revision, determine if it is on an even page, or an odd page (as page numbers alternate sides). Use this to set the horizontal position 'hpos' of the change bar
4) For each revision, determine the vertical start and stop points 'vstart' and 'vstop' of the bar (the way this is done now, it produces an expected error when a revision goes across two pages)
5) Using the hpos and vstart/vstop set, draw the line with required thickness

Feedback/help I'm looking for:

- Critique of and ideas for my approach, if you see a better way to approach this problem, etc
- Critique of and ideas for my coding for this approach, if you know of better methods/objects/properties to code with this approach

Thank you all in advance! Apologies for formatting.. not sure how to paste in with formatting.


Sub DrawChangeBarRev3()

' this revision:
' attempting to only handle insert/deletion changes
' Changed For Each loop to a For Next loop for revisions
' But changed it back, because that meant not selecting the rev

' **********************
' KNOWN ISSUES WITH THE FOLLOWING CODE:
'
' - If a revision extends across a page break, the bar
' is drawn in the wrong place. The code needs to be changed
' to draw two lines, one on the first page of the revision
' and the other on the second page.
'
' - If there are two or more revisions in the same line, the
' code draws a separate bar for each of them, both in the
' same place. Similarly, if you run the macro, make new
' revisions, and run the macro again, all the old revisions
' get another bar drawn on top of the existing bar.
'
' - No attempt is made to handle revisions in tables correctly.
'
' - There is no provision for deleting bars if the corresponding
' revision is accepted or deleted, or moving bars if other
' editing causes the existing revisions to shift up or down.
'
' - The screen updating should be turned off at the start of the
' macro and turned on at the end, to avoid visible scrolling
' in long documents.
' **********************

Dim rev As Revision
Dim saveSel As Range
Dim vStart As Single, vStop As Single
Dim hPos As Single
Dim vLine As Shape

' horizontal position 10 pt to left of left margin
' (suitable only for one-column text)
'hPos = Selection.Sections(1).PageSetup.LeftMargin - 10

' turn off balloons
'ActiveWindow.View.RevisionsMode = wdInLineRevisions

' save the current selection to go back to it at the end
Set saveSel = Selection.Range

For Each rev In ActiveDocument.Revisions

' Check if the revision is an insert or delete (might add others later)

If rev.Type = wdRevisionInsert Or wdRevisionDelete Then
rev.Range.Select
With Selection

'page even/odd?
If Selection.Information(wdActiveEndPageNumber) Mod 2 = 0 Then
'Easy, because left margin doesn't change

hPos = 42

Else

'unfortunately, RightMargin is distance from right edge of page, not absolute position
'consequently, I have to make a measurement from right edge of page. For portrait orientation
'this should always be the same, but if it's a landscape for a diagram, it won't be.
'so later i will ADD IN CHECK FOR HORIZONTAL/PORTRAIT ORIENTATION, ADJUST hPos ACCORDINGLY

hPos = InchesToPoints(8) - 4

End If

.Expand unit:=wdLine
vStart = .Information(wdVerticalPositionRelativeToPage)
.Collapse wdCollapseEnd
vStop = .Information(wdVerticalPositionRelativeToPage)
End With

Set vLine = ActiveDocument.Shapes.AddLine( _
beginx:=hPos, beginy:=vStart, _
endx:=hPos, endy:=vStop)
With vLine
.Line.ForeColor = RGB(0, 0, 0)
.Line.BackColor = RGB(0, 0, 0)
.Line.Weight = 8
End With
End If
Next rev

saveSel.Select
End Sub

[gmaxey]

This has giving me a raging headache. Perhaps I have advanced it some, but I suspect that this is a hairball that may never be fully functional. Easy solution is for MS to make the change bars customizable. I won't hold my breath. My simple practice file is available here: https://dl.dropboxusercontent.com/u/...ars.docm (https://dl.dropboxusercontent.com/u/...ars.docm Option)


Sub DrawChangeBarRev3()
Dim oRev As Revision
Dim saveSel As Range
Dim vStart As Single, vStop As Single
Dim hPos As Single
Dim vLine As Shape
Dim lngIndex As Long
Dim oRng As Word.Range
Dim lngRevs As Long

Dim oRRStart As Word.Range, oRREnd As Word.Range
' save the current selection to go back to it at the end
Set saveSel = Selection.Range
'Turn off balloons
ActiveWindow.View.RevisionsMode = wdInLineRevisions
lngRevs = ActiveDocument.Revisions.Count
For lngIndex = 1 To lngRevs 'ActiveDocument.Revisions.Count
ProcessGhosts:
Set oRev = ActiveDocument.Revisions(lngIndex)
'Check if the revision is an insert or delete (might add others later)
If oRev.Type = wdRevisionInsert Or wdRevisionDelete Then
Set oRRStart = oRev.Range
Set oRREnd = oRev.Range
oRRStart.Collapse wdCollapseStart
oRREnd.Collapse wdCollapseEnd
If oRRStart.Information(wdActiveEndPageNumber) < oRREnd.Information(wdActiveEndPageNumber) Then
'Revision spans a page. Process current page portion.
oRRStart.Select
Selection.Bookmarks("\Page").Select
Set oRng = Selection.Range
oRng.Start = oRRStart.Start
oRng.Select
DrawLine
'Process next page portion.
oRREnd.Select
Selection.Bookmarks("\Page").Select
Set oRng = Selection.Range
oRng.End = oRREnd.End
oRng.Select
DrawLine
Else
oRev.Range.Select
DrawLine
End If
End If
'Splitting revisions accross a page somehow alters the revision count ???
lngRevs = ActiveDocument.Revisions.Count
NextRev:
Next lngIndex
If lngIndex < lngRevs + 1 Then
GoTo ProcessGhosts
End If
saveSel.Select
End Sub

Function DrawLine()
Dim sngStart As Single, sngEnd As Single
Dim sngHPos As Single
Dim oShp As Shape
With Selection
'Even/odd?
If .Information(wdActiveEndPageNumber) Mod 2 = 0 Then
sngHPos = 42
Else
'unfortunately, RightMargin is distance from right edge of page, not absolute position
'consequently, I have to make a measurement from right edge of page. For portrait orientation
'this should always be the same, but if it's a landscape for a diagram, it won't be.
'so later i will ADD IN CHECK FOR HORIZONTAL/PORTRAIT ORIENTATION, ADJUST sngHPos ACCORDINGLY
sngHPos = InchesToPoints(8) - 4
End If
.Expand unit:=wdLine
sngStart = .Information(wdVerticalPositionRelativeToPage)
.Collapse wdCollapseEnd
.End = .End - 1
.Range.Select
sngEnd = .Information(wdVerticalPositionRelativeToPage) + (1.13 * .ParagraphFormat.LineSpacing)
If sngStart = sngEnd Then
sngEnd = sngStart + (1.13 * .ParagraphFormat.LineSpacing)
End If
End With
Set oShp = ActiveDocument.Shapes.AddLine(beginx:=sngHPos, beginy:=sngStart, endx:=sngHPos, endy:=sngEnd)
With oShp
.Line.ForeColor = RGB(0, 0, 0)
.Line.BackColor = RGB(0, 0, 0)
.Line.Weight = 3
End With
End Function

[Intern1]

Greg, thanks so much for responding. I did a lot of improvement to my original post's code. I think your edit to make drawing the line a separate function was much better practice than my jumble. I am just so darned confused by VBA structure/syntax still :/

Anyways, I discovered that the Revisions.Count won't actually cover all of the individual revision objects, interestingly, in my testing. As in, if I went from x = 1 to ActiveDocument.Revisions.Count, and did For ActiveDocument.Revisions(x), it would NOT cover all of the revisions. Is the count and the actual ID for an individual Revision object done differently? As in, maybe I made one Delete and one Insert on a line. Maybe this increments the Count by 1, but create TWO Revision objects? The mysteries of Word elude me.

This newer version of what I have addresses some of the issues, like the across-page edits. The only problem is, I think I have some major inefficiency, as it will max out Cores 0/1 of my laptop CPU and crash Word. I can get it to work on a more powerful desktop, but of course it'd be best if I could reduce CPU load if at all possible.

Below is the latest I had up to right now, when I read your post. I'll give yours a go later. Again, thanks a bunch for responding to me. I'm hoping to get some heads together here and hammer this out, in the open, and get the best solution we can for people who run into this problem several times a year. Because I have a pretty sure feeling that some places have in-house solutions to this that they don't feel like sharing.

So here's my goal: I want to keep tweaking this to cover those cases (edits going across pages, edits to table cells, etc), and have someone like you, who can help improve the structure of the coding (like creating and calling a DrawLine function).



Option Explicit
Sub DrawChangeBarRev5()
' this revision:
' Handles Landscape Pages:
' Uses a different hPos for landscape after
' recognizing a landscape page,
' without losing across-page functionality

'
' **********************
' KNOWN ISSUES WITH THE FOLLOWING CODE:
' - If there are two or more revisions in the same line, the
' code draws a separate bar for each of them, both in the
' same place. Similarly, if you run the macro, make new
' revisions, and run the macro again, all the old revisions
' get another bar drawn on top of the existing bar.
'
' - Tables will not always correctly mark revisions.
'
' - There is no provision for deleting bars if the corresponding
' revision is accepted or deleted, or moving bars if other
' editing causes the existing revisions to shift up or down.
'
' - The screen updating should be turned off at the start of the
' macro and turned on at the end, to avoid visible scrolling
' in long documents.
' **********************
Dim rev As Revision
Dim saveSel As Range
Dim vStart As Single, vStop As Single
Dim hPos As Single
Dim vLine As Shape
Dim intA As Single, intB As Single
Dim Lbar As Single, Rbar As Single
Dim PageTop As Single, PageBottom As Single
Dim iCount As Single
Dim RbarLand As Single
Dim begLand As Boolean, endLand As Boolean

begLand = False
endLand = False


PageTop = 60
PageBottom = 708

Lbar = 40
Rbar = 572
RbarLand = 735


ActiveWindow.View.RevisionsMode = wdInLineRevisions

' save the current selection to go back to it at the end

Application.ScreenUpdating = False

Set saveSel = Selection.Range

For Each rev In ActiveDocument.Revisions


' Check if the revision is an insert or delete (can add others later)
' If you want to mark all types of revisions, comment about the If line here and
' the End If at the bottom (marked with another comment down there).
' You may also

'If rev.Type = wdRevisionInsert Or wdRevisionDelete Then
rev.Range.Select
With Selection

.MoveEnd Unit:=wdCharacter, Count:=-1

'page even/odd where selection starts?
If Selection.Information(wdActiveEndPageNumber) Mod 2 = 0 Then
'Easy, because left margin doesn't change

hPos = Lbar

Else

hPos = Rbar

End If

vStart = .Information(wdVerticalPositionRelativeToPage) - 4

.Collapse Direction:=wdCollapseEnd

If rev.Range.PageSetup.Orientation = wdOrientLandscape Then
endLand = True
End If

vStop = .Information(wdVerticalPositionRelativeToPage) + 14


If vStop < vStart Then


'Move currently selected spot back onto original page
Do While .Information(wdVerticalPositionRelativeToPage) < vStop

.Move Unit:=wdLine, Count:=-1
.Move Unit:=wdCharacter, Count:=-1

Loop

If rev.Range.PageSetup.Orientation = wdOrientLandscape Then
begLand = True
End If

'Original Page, so that side of page
If hPos < 100 Then

If begLand Then
hPos = RbarLand
Else
hPos = Rbar
End If

Else
hPos = Lbar
End If

'Draw line on that original page
Set vLine = ActiveDocument.Shapes.AddLine( _
beginx:=hPos, beginy:=vStart, _
endx:=hPos, endy:=PageBottom)
With vLine
.Line.ForeColor = RGB(0, 0, 0)
.Line.BackColor = RGB(0, 0, 0)
.Line.Weight = 8
End With

'Preparing to go on the second page, hPos must be opposite side of page
If hPos < 100 Then
hPos = Rbar
Else
hPos = Lbar
End If



'Move currently selected spot back down to second page
Do While Selection.Range.Information(wdVerticalPositionRelativeToPage) > vStop

.Move Unit:=wdLine, Count:=1
.Move Unit:=wdCharacter, Count:=1

Loop

Set vLine = ActiveDocument.Shapes.AddLine( _
beginx:=hPos, beginy:=PageTop, _
endx:=hPos, endy:=vStop)
With vLine
.Line.ForeColor = RGB(0, 0, 0)
.Line.BackColor = RGB(0, 0, 0)
.Line.Weight = 8
End With

Else


If endLand Then
hPos = RbarLand
End If

Set vLine = ActiveDocument.Shapes.AddLine( _
beginx:=hPos, beginy:=vStart, _
endx:=hPos, endy:=vStop)
With vLine
.Line.ForeColor = RGB(0, 0, 0)
.Line.BackColor = RGB(0, 0, 0)
.Line.Weight = 8
End With

End If








End With


' comment out this End If, along with the If for the Revision Types,
' if you wish to mark all revision types

'End If

'For iCount = 1 To 1000
' Next iCount

begLand = False
endLand = False

Next rev

saveSel.Select

Application.ScreenUpdating = True
End Sub

[gmaxey]

Do you have a name? I feel silly referring to someone as Intern1. I'll let this rest until you've had a chance to look at the code I posted. In my very limited testing, it seems to work with the across page case. Good luck.

[Frosty]

I'm going to take a look at this... but one quick item on your list of issues with the code: Tables not always marking revisions. Word has problems tracking changes within Tables. If you make heavy use of tables in these documents, everything else you code here could be academic.

You may want to look at getting an actual product for this (Workshare's Compare product I have actual experience with, am currently testing Workshare Compare 9 -- I also know of CompareDocs). I can tell you that Workshare does *not* provide additional options for line width, so you would still end up at the same spot). However, it does provide the ability to generate a Word-native track changes document, at which point you'd be in the same boat, but with tables comparing properly. But maybe CompareDocs (or some other redlining program) actually allows you to change the width of the tracking line in a rendering set... so, that might be worth investigating, vba fun notwithstanding.

I'm not sure how you would address the tables comparing properly using word's native engine, without rewriting the entire thing.

Quick summary (no code yet) of the other issues:
1. Name your shapes when you're inserting them, with some kind of static prefix "revIndicator_" as well as a random number at the end. This will let you rapidly identify (and delete) later.
2. You'll probably want a separate process to then go through all of your "revIndicator_" shapes at the end of the process, and simply remove redundant ones, if needed, or extend overlapping ones. But you'd definitely want this as a separate process.
3. Use of the selection (even with screen updating off), will slow your processing significantly.
4. I would say that you need to start using better structure right now, rather than later. Better structure isn't cosmetic. It shortens the development time. You have the following issues to address: a) identifying revisions b) location on the "page" (always tricky in word) c) identifying overlaps and reducing them d) processing speed... and then you have a really really big issue staring you in the face:

What is your main loop going to be?

I'm not convinced that you're actually going to want to go through each revision. It may be better to go through each PAGE object... or through each SECTION.

Both have their issues -- but if you keep developing in a "one procedure wonder" kind of way -- you're really going to go down some rabbit holes, which creating sub functions will help alleviate the amount of time you spend tearing everything apart and trying to put it back together.

I would have a separate function which simply inserts a line, with a name, at a given horizontal position, defined by a top and bottom position.

I suspect it may be better to loop through each page in the document, and figure out whether the entire page needs a single line, or whether it needs 3 lines that start at various spots, etc.

More to come, but the important point is that you should really rethink not separating into separate functions right now... and whether there is already a 3rd party product which does this. My instinct is the same as Greg's: this may never work reliably (or, rather -- it may cost you more than simply printing out the document, taking a thick pen to each page to make the lines thicker, and then scanning the entire document to publish).

[Frosty]

Oh, and the other big performance hit is use of the .Information function -- but you can't get around that. I'm guessing that the CPU optimizations will likely revolve around minimizing use of the Selection object (always the case), but also the .Information method.

[gmaxey]

Jason,

Thanks for jumping in I really didn't have the right frame of mind, or the time for that matter, to give this serious thought yesterday. It I certainly a weird one. If you look at that simple test document I put in dropbox, you will see that it starts out with six revisions. However it appears as the revision that splits the page is processed, another (Ghost) revision is created. The revision count jumps to 7. With out the check after my loop, the last revision isn't processed. I just now tried replacing the For lngIndex loop with a For Each loop. However that results in a continuous loop trying to process the ghost revision.

[Intern1]

Okay thank you all for pitching in. You can call me Mitchell, Greg, since I would agree 'intern' is a little silly in conversation. I tried your code, and I liked it. I was tweaking it for landscape and I think I got that settled. So I could use that for most purposes. Of course, I want to take this as far as I can (trying to not crash Word on my machine, for example, or covering the entirety of inserted pictures' change bars).

Outside purchase isn't really a card in my hand because of my position (intern), and that I'm the one, specifically, who has to draw these bars (did so for one full day already, thus the hunt for a solution in VBA).

So, I'm sticking with my intent to get as good of a solution, acknowledging that it may never be perfect, in VBA. I think I want to re-start with some outlining here, and then have you guys break that down again so we can point to structuring. The only main loop I had been able to come up with, for being able to cover every revision, is by revision. Are you saying, though, that I could go by page, and select revisions in the page? It does look like Revisions is a part of Range. (I think I need to reiterate that I've NEVER written a macro in my life before this week. But I'm ears for learning and I appreciate you guys doing what you can to help me understand).

With your guys' input in mind, here's my new attempt's psuedo-english trying to incorporate what you mentioned for structure






MAIN METHOD
Select first page (I know you said minimize Selection, but I don't know how else to select current page range)
Loop: condition to stop after going through every page
with current page
determine page number and orientation of page
set variable for calling correct drawline function (e.g. EvenLand, OddPort)
from index = 1 to selection.range.revisions.count
for selections.range.revisions(index)
Get verticals for start/stop of revision
Call correct drawline function knowing the orientation/number of page using... an If/If Else/Else?
Next Index (this has an issue with Revisions.Count, I believe, that Greg addressed in his code)
Next Index

---------- other functions

DrawLineEvenPort (Don't needto change horizontal for left-side margin on landscape)
hPos is set for the method
verticals could be set as global variables?
name for the shape could be incrementing a global variable like 'changebar' + ChangeBarIndex
draw the line

DrawLineOddPort...

DrawLineOddLand...





As far as concepts, you're saying I should also look to reduce drawing duplicate bars. Do you have ideas on where I can identify these? In the main method? In the drawing method?

Is this an appropriate step to stop and critique the outline? What other kind of loop ideas do you guys have? Is there some re-arrangement I could/should do as far as finding/storing things like page orientation and page number? I'm trying to figure out how I can best help you guys help me.

Cheers,

Mitchell

[gmaxey]

Jason/Mitchell,

This is a real head banger :banghead:. I've adapted the my code to use Pages/Panes/and Rectangles so the revisions on each page is processed before moving to the next page. This keeps ActiveDocument.Revisions.Count out of the process. However that still left page revisions count and as before processing a revision that jumps a page seem play headgames with revision count.

What I've done here is for record the start and end ranges of each revision before trying to process them and then process the ranges instead of the revisions.

The next thing I tripped over was add a shape appears to alter subsequent range start/end points by one. So when processing the third revision range, the start and end points have to be increased by 2.

It seems to be working with the small sample file I've posted in drop box.

https://dl.dropboxusercontent.com/u/64545773/Demo%20Rev%20Bars.docm

I guess the next thing is to attempt to prevent doubling up lines and then tables.

I have to break for awhile though and let you guys take a stab at it. Have fun.

[gmaxey]

Gents,

I think I've taken this thing about as far as my limited skills allows. I have added a process to name the shapes so they can all be deleted if the macro is run again on the same document and again with very limited testing it is marking table revisions. The task of preventing duplicate or overlapping lines seems unachievable to me at least within the framework of the existing code. It seems there is no reference or association with the beginning and ending vertical position used to create the shape after the shape is created. The process, if one can be created, to ensure lines aren't duplicated or overlapping may be more o a resource drain than leaving them as they are. In the demo document in dropbox the first two paragraphs consist of a change on each line and a change that spans both lines. In each case the result is a long line that spans the paragraph that is covering two shorter lines. The end result is the change is marked in the margin.

I'll keep watching this thread for comments. With Jason drawing a bead here, I suspect it will be advanced even more.



Option Explicit
Private lngRevLineIndex As Long
Private oShpRevLine As Shape

Sub DrawChangeBarRev4()
Dim oPage As Page
Dim oRec As Rectangle
Dim oRngPage As Range, oRngRev As Range
Dim lngIndex As Long
Dim lngRev As Long, lngRevRanges As Long
Dim oCol As Collection
Dim arrSE() As String
Dim lngDrawingCount As Long
DeleteRevLines
'Using Panes and Rectangles
For lngIndex = 1 To ActiveDocument.ActiveWindow.Panes(1).Pages.Count
'Evaluate each page.
Set oPage = ActiveDocument.ActiveWindow.Panes(1).Pages(lngIndex)
'Evaluate main text.
Set oRec = oPage.Rectangles(1)
Set oRngPage = oRec.Range
Set oCol = New Collection
lngDrawingCount = 0
'Since manipulating revisons in a loop seems to affect the revision count, first
'store the the start and end range value of each revision on the page.
For lngRev = 1 To oRngPage.Revisions.Count
Set oRngRev = oRngPage.Revisions(lngRev).Range
If oRngRev.Start < oRngPage.Start Then
'Clip revisions that begin on a previous page.
oRngRev.Start = oRngPage.Start
End If
If oRngRev.End > oRngPage.End Then
'Clip revisions the extend to the next page.
oRngRev.End = oRngPage.End
End If
'Store the values.
oCol.Add oRngRev.Start & "|" & oRngRev.End
Next lngRev
'Now process the ranges in the collection.
For lngRevRanges = 1 To oCol.Count
arrSE = Split(oCol.Item(lngRevRanges), "|")
Set oRngRev = oRngPage
'Since adding a line drawing apparently effects the ranges,
'adjust the start and end points.
oRngRev.Start = CLng(arrSE(0)) + lngDrawingCount
oRngRev.End = CLng(arrSE(1)) + lngDrawingCount
oRngRev.Select
lngRevLineIndex = lngRevLineIndex + 1
DrawLine
lngDrawingCount = lngDrawingCount + 1
Next lngRevRanges
Next lngIndex
End Sub
Function DrawLine()
Dim sngStart As Single, sngEnd As Single
Dim sngHPos As Single
Dim lngIndex As Long
Dim oShpCompare As Shape

With Selection
'Even/odd?
If .Information(wdActiveEndPageNumber) Mod 2 = 0 Then
sngHPos = 42
Else
sngHPos = InchesToPoints(8) - 4
End If
.Expand unit:=wdLine
sngStart = .Information(wdVerticalPositionRelativeToPage)
.Collapse wdCollapseEnd
.End = .End - 1
.Range.Select
sngEnd = .Information(wdVerticalPositionRelativeToPage) + (1.13 * .ParagraphFormat.LineSpacing)
If sngStart = sngEnd Then
sngEnd = sngStart + (1.13 * .ParagraphFormat.LineSpacing)
End If
End With
Set oShpRevLine = ActiveDocument.Shapes.AddLine(beginx:=sngHPos, beginy:=sngStart, endx:=sngHPos, endy:=sngEnd)
With oShpRevLine
.Name = "RevBar-" & lngRevLineIndex
.Line.ForeColor = RGB(0, 0, 0)
.Line.BackColor = RGB(0, 0, 0)
.Line.Weight = 3
End With
End Function
Function DeleteRevLines()
Dim lngIndex As Long
Dim oShp As Word.Shape
For lngIndex = ActiveDocument.Shapes.Count To 1 Step -1
Set oShp = ActiveDocument.Shapes(lngIndex)
If InStr(oShp.Name, "RevBar") = 1 Then
oShp.Delete
End If
Next lngIndex
lbl_Exit:
Exit Function
End Function

[Intern1]

Greg, I'm getting a run-time error, maybe there's something I don't have set up that you do?

Run-time error '5941':
The requested member of the collection does not exist.

Debug points to the line

Set oLine = oRec.Lines(4)

Thanks again for all of your work on this.

- Mitchell

[Intern1]

Also, this is how I handled the landscape page case in your original version:



Option Explicit
Dim land As Boolean



Sub GregChangeBar()
Dim oRev As Revision
Dim saveSel As Range
Dim vStart As Single, vStop As Single
Dim hPos As Single
Dim vLine As Shape
Dim lngIndex As Long
Dim oRng As Word.Range
Dim lngRevs As Long


Dim oRRStart As Word.Range, oRREnd As Word.Range
' save the current selection to go back to it at the end
Set saveSel = Selection.Range
'Turn off balloons
ActiveWindow.View.RevisionsMode = wdInLineRevisions
lngRevs = ActiveDocument.Revisions.Count
For lngIndex = 1 To lngRevs 'ActiveDocument.Revisions.Count
ProcessGhosts:
Set oRev = ActiveDocument.Revisions(lngIndex)
'Check if the revision is an insert or delete (might add others later)
If oRev.Type = wdRevisionInsert Or wdRevisionDelete Then
Set oRRStart = oRev.Range
Set oRREnd = oRev.Range
oRRStart.Collapse wdCollapseStart
oRREnd.Collapse wdCollapseEnd
If oRRStart.Information(wdActiveEndPageNumber) < oRREnd.Information(wdActiveEndPageNumber) Then
'Revision spans a page. Process current page portion.
oRRStart.Select
Selection.Bookmarks("\Page").Select
Set oRng = Selection.Range
oRng.Start = oRRStart.Start
oRng.Select
If Selection.PageSetup.Orientation = wdOrientLandscape Then
land = True
End If
DrawLine
land = False
'Process next page portion.
oRREnd.Select
Selection.Bookmarks("\Page").Select
Set oRng = Selection.Range
oRng.End = oRREnd.End
oRng.Select
If Selection.PageSetup.Orientation = wdOrientLandscape Then
land = True
End If
DrawLine
Else
oRev.Range.Select
If Selection.PageSetup.Orientation = wdOrientLandscape Then
land = True
End If
DrawLine
End If
End If
'Splitting revisions accross a page somehow alters the revision count ???
lngRevs = ActiveDocument.Revisions.Count
land = False
NextRev:
Next lngIndex
If lngIndex < lngRevs + 1 Then
GoTo ProcessGhosts
End If
saveSel.Select
End Sub

Function DrawLine()
Dim sngStart As Single, sngEnd As Single
Dim sngHPos As Single
Dim oShp As Shape
With Selection
'Even/odd?
If .Information(wdActiveEndPageNumber) Mod 2 = 0 Then
sngHPos = 42
Else
If land Then

sngHPos = 1150
Else
sngHPos = InchesToPoints(8) - 4
End If

End If
.Expand unit:=wdLine
sngStart = .Information(wdVerticalPositionRelativeToPage)
.Collapse wdCollapseEnd
.End = .End - 1
.Range.Select
sngEnd = .Information(wdVerticalPositionRelativeToPage) + (1.13 * .ParagraphFormat.LineSpacing)
If sngStart = sngEnd Then
sngEnd = sngStart + (1.13 * .ParagraphFormat.LineSpacing)
End If
End With
Set oShp = ActiveDocument.Shapes.AddLine(beginx:=sngHPos, beginy:=sngStart, endx:=sngHPos, endy:=sngEnd)
With oShp
.Line.ForeColor = RGB(0, 0, 0)
.Line.BackColor = RGB(0, 0, 0)
.Line.Weight = 3
End With
End Function

[gmaxey]

Mitchell,

That is left over chaff. Sorry. Just delete that line and all reference to oLine

[Intern1]

I have to move on to other things for the day, but I have one quick question: can I make a method that takes arguments? This didn't seem like it should be difficult but I don't quite get VBA syntax. I ask because I'd like to be able to call a DrawLine function with start y-coordinate and end y-coordinate as arguments passed to the method. This would make structuring way simpler for me if I could do that.

Here's the next bump-up I took from my old code, with these new ideas incorporated. I'll do a full re-write once I get things figured out like my question above.



Option Explicit

Sub DrawChangeBarRev6()

' this revision:
' improved vStart/vStop determination
' improved handling of across-page revisions
'
'
'
' **********************
' KNOWN ISSUES WITH THE FOLLOWING CODE:
' - If there are two or more revisions in the same line, the
' code draws a separate bar for each of them, both in the
' same place. Similarly, if you run the macro, make new
' revisions, and run the macro again, all the old revisions
' get another bar drawn on top of the existing bar.
'
' - Tables will not always correctly mark revisions.
'
' - There is no provision for deleting bars if the corresponding
' revision is accepted or deleted, or moving bars if other
' editing causes the existing revisions to shift up or down.
'
' - The screen updating is turned off at the start of the
' macro and turned on at the end, to avoid visible scrolling
' in long documents.
'
' - The macro is configurable as to which types of revisions get
' change bars. Currently, only Deletion, Insertion, and Replace are
' configured for change bars. See comments in code below.
'
' - Images will not be fully covered by change bars. It is treated
' as a single-line insertion
' **********************

Dim rev As Revision
Dim saveSel As Range
Dim RevStart As Word.Range
Dim RevEnd As Word.Range
Dim vStart As Single, vStop As Single
Dim hPos As Single
Dim vLine As Shape
Dim intA As Single, intB As Single
Dim Lbar As Single, Rbar As Single
Dim PageTop As Single, PageBottom As Single
Dim iCount As Single
Dim RbarLand As Single
Dim begLand As Boolean, endLand As Boolean

begLand = False
endLand = False


PageTop = 60
PageBottom = 708

Lbar = 40
Rbar = 572
RbarLand = 1185


ActiveWindow.View.RevisionsMode = wdInLineRevisions

' save the current selection to go back to it at the end

Application.ScreenUpdating = False

Set saveSel = Selection.Range

For Each rev In ActiveDocument.Revisions


' Check if the revision is an insert or delete (can add others later)
' If you want to mark all types of revisions, comment about the If line here and
' the End If at the bottom (marked with another comment down there).
' You may also add others, like Or wdRevisionMovedFrom Or wdRevisionMovedTo
If rev.Type = wdRevisionInsert Or wdRevisionDelete Or wdRevisionReplace Then
rev.Range.Select
With Selection

'.MoveEnd unit:=wdCharacter, Count:=-1

Set RevStart = rev.Range
Set RevEnd = rev.Range
RevStart.Collapse wdCollapseStart
RevEnd.Collapse wdCollapseEnd
RevEnd.MoveEnd Unit:=wdCharacter, Count:=-1

'First, assume all on same page as beginning of selection
'So check beginning orientation and page number

If RevStart.PageSetup.Orientation = wdOrientLandscape Then
begLand = True
End If

'Clarification: this is internal number not visible number in footer
If RevStart.Information(wdActiveEndPageNumber) Mod 2 = 0 Then

hPos = Lbar

Else
hPos = Rbar
End If



vStart = RevStart.Information(wdVerticalPositionRelativeToPage)



If RevStart.PageSetup.Orientation = wdOrientLandscape Then
begLand = True
End If

vStop = RevEnd.Information(wdVerticalPositionRelativeToPage) + 12


If RevStart.Information(wdActiveEndPageNumber) < RevEnd.Information(wdActiveEndPageNumber) Then

'Need to check only now if 'second' page is landscape
If RevEnd.PageSetup.Orientation = wdOrientLandscape Then
endLand = True
End If

If hPos = Rbar And endLand Then
hPos = RbarLand
End If

'Draw line on that original page
Set vLine = ActiveDocument.Shapes.AddLine( _
beginx:=hPos, beginy:=vStart, _
endx:=hPos, endy:=PageBottom)
With vLine
.Line.ForeColor = RGB(0, 0, 0)
.Line.BackColor = RGB(0, 0, 0)
.Line.Weight = 8
End With

'Select Second Page
RevEnd.Select
If RevEnd.Information(wdActiveEndPageNumber) Mod 2 = 0 Then
hPos = Lbar
Else
hPos = Rbar
End If

If endLand And hPos = Rbar Then
hPos = RbarLand
End If

Set vLine = ActiveDocument.Shapes.AddLine( _
beginx:=hPos, beginy:=PageTop, _
endx:=hPos, endy:=vStop)
With vLine
.Line.ForeColor = RGB(0, 0, 0)
.Line.BackColor = RGB(0, 0, 0)
.Line.Weight = 8
End With

Else

If begLand And hPos = Rbar Then
hPos = RbarLand
End If

RevStart.Select

Set vLine = ActiveDocument.Shapes.AddLine( _
beginx:=hPos, beginy:=vStart, _
endx:=hPos, endy:=vStop)
With vLine
.Line.ForeColor = RGB(0, 0, 0)
.Line.BackColor = RGB(0, 0, 0)
.Line.Weight = 8
End With

End If








End With


' comment out this End If, along with the If for the Revision Types,
' if you wish to mark all revision types

End If

'For iCount = 1 To 1000
' Next iCount

begLand = False
endLand = False

Next rev

saveSel.Select

Application.ScreenUpdating = True
End Sub



EDIT: updated some things. I had an error about...

1) hpos was wrong for landscape (is correct now)
2) forgot to select RevStart before drawing line

[gmaxey]

Sure:

Sub Demo()
Dim oShp As Shape
Set oShp = fcnDrawLine(50, 100, 50, 250)
End Sub
Function fcnDrawLine(ByVal lngX1 As Long, lngY1 As Long, lngX2 As Long, lngY2 As Long) As Shape
Set fcnDrawLine = ActiveDocument.Shapes.AddLine(lngX1, lngY1, lngX2, lngY2)
End Function


I think you will have better results with Panes/Pages/Rectangles approach.

[Intern1]

Ok, for now I've decided that as long as I have one computer it'll run clean on, I'll keep moving on to other things.

For example, images. Images currently only get a changebar, with my code, for the line on which it was inserted (which seems to consistently be the bottom of the image, thankfully). So to draw a change bar for the full length, I believe I would just need to add the height of the image. To do THAT, I need to understand images in Word a bit better. Since thinking 'I want to learn to write a macro' two weeks ago, I have come to hate MSDN documentation with my full heart. Finding the information I need is a complete pain the ***, and it doesn't seem to add clarifying information where it really needs it.

So I make a bunch of assumptions and test them out.

Assumption #1: An image inserted in a Word document, like diagrams for the documents, would be a 'Shapes' object. Then, a property of that object is Shape.RelativeVerticalSize which I can use to determine the distance I need to adjust my change bar's height by for that 'revision'.

Assumption #2: To identify a 'shape' in a revision, I can use some way to identify it.


Just read this after writing my assumptions: can't post this link b/c forum tells me I can't. Kinda frustrating.

So, seems #2 is kinda right but I wasn't expecting to have to identify in two different ways. And it seems like the ways he is looping through images to identify them is by using a For loop that just goes picture1,2,3,4,5... In my context, I need to be able to identify shapes in my specific selection. Seems that InLineShapes and ShapeRange are properties of Selection. Using this, I should be able to see if the revision HAS a shape in it by doing some kind of line like


rev.select
AddedHeight = 0
pic = Nothing (?)
For x = 0 to selection.ShapeRange.ShapeCount
pic = selection.ShapeRange(x)
If pic.Type = msoPicture Then
AddedHeight = AddedHeight + pic.RelativeVerticalHeight
End If
Next


and then I'd have to repeat this for going through InLineShapes? Or would that be covered by the ShapeRange? I can't tell. Sorry for expressing frustration here. It's cool to see what can be done with VBA but all I can think of right now is how much MORE could be done with VBA if this weren't such a load of .... to trudge through.

[gmaxey]

You should be able to use the .height property of the shape


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim lngHeight As Long, lngCalculatedStart As Long
Dim oShpRevLine As Shape
If ActiveDocument.Revisions(1).Range.InlineShapes.Count = 1 Then
lngHeight = ActiveDocument.Revisions(1).Range.InlineShapes(1).Height
lngCalculatedStart = 100 '(whatever the calculated revision start is)
Set oShpRevLine = ActiveDocument.Shapes.AddLine(beginx:=50, beginy:=lngCalculatedStart, endx:=50, endy:=lngCalculatedStart + lngHeight)
With oShpRevLine
.Line.ForeColor = RGB(0, 0, 0)
.Line.BackColor = RGB(0, 0, 0)
.Line.Weight = 3
End With

End If
End Sub

[Intern1]

I know it's a VERY fringe case, but I think I'm going to use a loop after an If statement with a > 0 for the count of images.

The possibility is, someone pasted in two images at once. That would count as a single revision, I believe.

Again, thanks for your help with syntax/structure/concepts, Greg. I've been on other projects lately but I should have time to clean up and write a good, clean, well-structured piece in the coming weeks.

[gmaxey]

I've not had time to dig into it, but when I tried running your code posted above it encounters a continuous loop.

[Intern1]

That's strange, I haven't encountered that issue