Word VBA - recursively add macrobutton fields - order reversed

P

paulrandrews

Hi All,
I have developed a vba userform and module that allows a user to
select files from a treeview control. These files are then populated
into a word document as macrobutton fields which allow the user to
click on the text and open a clearcase version tree.

The files must be displayed with their full path and clearcase version
number so the text is quite long.

In order to circumvent this problem, I created a hierarchical
recordset and group the files by directory path.

I use a bookmark to identify where to put the resulting file list and
am using Range.Fields.Add the files as macrobuttons.

PROBLEM: When adding the fields, the order is reversed (...and no, I
can't reverse the order as the directory name is added as a quote
field ... a workaround to the problem of text being overwritten when
fields are added to the range).

Output should be in a cell in a table in the following form:

\\unc\path\to\directory1
<tab>filename1
<tab>filename2

\\unc\path\to\directory2
<tab>filename3
<tab>filename4

Actual output is:

<tab>filename4
<tab>filename3
\\unc\path\to\directory2

<tab>filename2
<tab>filename1
\\unc\path\to\directory1


Code:

While Not rsDirs.EOF


Set fld = rngSourceObjects.Fields.Add(rngSourceObjects,
wdFieldQuote, rsDirs("Directory").Value, False)
fld.Select
Selection.InsertAfter vbCrLf

Set rsFiles = rsDirs("rsFiles").Value

While Not rsFiles.EOF

Set fld = rngSourceObjects.Fields.Add(rngSourceObjects,
wdFieldMacroButton, " ViewVersionTree " & rsFiles("Filename").Value &
rsFiles("Version").Value, False)
fld.Code.Fields.Add rngSourceObjects, wdFieldPrivate, i,
False
fld.Select
Selection.InsertBefore vbTab
Selection.InsertAfter vbCrLf


rngFileNames.Cells(1).Range.Text = rngFileNames.Cells
(1).Range.Text & rsFiles("Filename").Value & vbCrLf & vbCrLf
rsFiles.MoveNext
Wend

rsDirs.MoveNext
i = i + 1
Wend

I <think> I should be updating the location of the rngSourceObjects
range after each field is added.

Any help greatly appreciated.

Regards, Paul.
 
D

Doug Robbins - Word MVP

Try something like

Dim arange As Range
With ActiveDocument
Set arange = .Bookmarks("Test").Range
arange.Collapse wdCollapseStart
Set afield = .Fields.Add(arange, Text:="SEQ Test") 'modify to suit
Set arange = .Bookmarks("Test").Range
arange.Collapse wdCollapseEnd
arange.InsertAfter vbCr & " "
arange.Start = arange.End + 1
arange.End = arange.End + 2
.Bookmarks.Add "Test", arange
Set arange = .Bookmarks("Test").Range
arange.Start = arange.Start - 1
.Bookmarks.Add "Test", arange
End With


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP
 
P

paulrandrews

Many thanks Doug. Based on your suggestions the following works (not
pretty...but functional).

Thanks again, Paul.

Set rngSourceObjects = ActiveDocument.GoTo(What:=wdGoToBookmark,
Name:="REVIEWOBJECTS")
Set rngFileNames = ActiveDocument.GoTo(What:=wdGoToBookmark,
Name:="FILENAMES")

Options.ButtonFieldClicks = 1


rsDirs.MoveFirst

Dim bkmk As Bookmark
Dim rng As Range


While Not rsDirs.EOF
rngSourceObjects.InsertAfter rsDirs("Directory").Value
rngSourceObjects.Collapse WdCollapseDirection.wdCollapseEnd
ActiveDocument.Bookmarks.Add "REVIEWOBJECTS", rngSourceObjects
rngSourceObjects.Collapse WdCollapseDirection.wdCollapseEnd
rngSourceObjects.InsertAfter vbCrLf & " "


Set rngSourceObjects = ActiveDocument.GoTo
(What:=wdGoToBookmark, Name:="REVIEWOBJECTS")

Set rsFiles = rsDirs("rsFiles").Value

While Not rsFiles.EOF
rngSourceObjects.Collapse
WdCollapseDirection.wdCollapseEnd

Set fld = rngSourceObjects.Fields.Add(rngSourceObjects,
wdFieldMacroButton, " ViewVersionTree " & rsFiles("Filename").Value &
rsFiles("Version").Value, False)
fld.Code.Fields.Add rngSourceObjects, wdFieldPrivate, i,
False
fld.Select
Selection.InsertBefore vbTab
Selection.InsertAfter vbCrLf

rngSourceObjects.Start = fld.Code.End + 1
rngSourceObjects.End = fld.Code.End + 2
ActiveDocument.Bookmarks.Add "REVIEWOBJECTS",
rngSourceObjects
rngSourceObjects.Collapse
WdCollapseDirection.wdCollapseEnd

rngFileNames.Cells(1).Range.Text = rngFileNames.Cells
(1).Range.Text & rsFiles("Filename").Value & vbCrLf & vbCrLf
rsFiles.MoveNext
Wend

rsDirs.MoveNext
i = i + 1
Wend
 
Top