TOC

[ceilidh]

OK, this is my last question for a while. I thought I'd start a new thread since it's not a page numbering problem. (I'll post my final page number code on that thread after posting this)

I'm sticking a bunch of individual tables together into one document. That code works. I decided to try and add a TOC. That code also works in that I do get a TOC and the numbering is exactly how I wanted it. (I have to manually edit the bit that says "Output n" after the TOC is created, with the actual table description, but that is ok. I made it white so the text is not visible on the table itself as I don't want to see "Output 1" on the tables.)

Here's my problem. For some reason, the headers and footers are getting wiped when I add the TOC. The TOC is created but I need the headers and footers to stay as they are and not get wiped (the body of the document is unaffected) during the creation.

Any advice here...? Here's the part of my code that is sticking the tables together into one doc and putting the TOC on the front:



' This opens your text file of tables to load
Open strPath & "\" & strFileName For Input As #lngFileNum
' Define the size of either a standard portrait or landscape page
Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
With ActiveDocument.PageSetup
.LineNumbering.Active = False
If UCase(Trim(strLPsetting)) = "P" Then
.Orientation = wdOrientPortrait
Else
.Orientation = wdOrientLandscape
End If
.TopMargin = InchesToPoints(gdblTopMargin)
.BottomMargin = InchesToPoints(gdblBottomMargin)
.LeftMargin = InchesToPoints(gdblLeftMargin)
.RightMargin = InchesToPoints(gdblRightMargin)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(gdblHeaderDistance)
.FooterDistance = InchesToPoints(gdblFooterDistance)
.PageWidth = InchesToPoints(dblWidth)
.PageHeight = InchesToPoints(dblHeight)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.GutterPos = wdGutterPosLeft
End With
' Set to print view
If ActiveWindow.ActivePane.View.Type = wdNormalView _
Or ActiveWindow.ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
' Insert a TOC
Set rngWordRange = ActiveDocument.Range(Start:=0, End:=0)
ActiveDocument.TablesOfContents.Add rngWordRange, _
UseFields:=True, _
UseHeadingStyles:=True, _
LowerHeadingLevel:=3, _
UpperHeadingLevel:=1
' Now insert a pagebreak and put the cursor on the last page
Selection.InsertBreak Type:=wdPageBreak
Selection.EndKey Unit:=wdStory
TableNumber = 0

Do While Not EOF(lngFileNum)
Line Input #lngFileNum, strTextLine
' This steps through your text file, line by line, storing the table name to load
'+-------------------------------------------------+
'| Loop through the files in the text file and put |
'| them in the document with a Section Break. |
'+-------------------------------------------------+
TableNumber = TableNumber + 1
ActiveDocument.Content.InsertAfter "Output " & TableNumber
Selection.EndKey Unit:=wdStory
Cnt = Len(Trim("Output " & TableNumber))
Selection.MoveLeft Unit:=wdCharacter, Count:=Cnt, Extend:=wdExtend
Selection.Style = ActiveDocument.Styles("Heading 1,Numbered - 1")
Selection.Font.Color = wdColorWhite
ActiveDocument.Content.InsertParagraphAfter
Selection.EndKey Unit:=wdStory
Selection.InsertFile FileName:=strPath & strTextLine, _
Range:="", ConfirmConversions:=False, _
Link:=False, Attachment:=False
'Turn off link to previous footer.
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
If Selection.HeaderFooter.LinkToPrevious = True Then
Selection.HeaderFooter.LinkToPrevious = False
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
'Turn off link to previous header.
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
If Selection.HeaderFooter.LinkToPrevious = True Then
Selection.HeaderFooter.LinkToPrevious = False
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Selection.InsertBreak Type:=wdSectionBreakNextPage
Loop
Close #lngFileNum
For Each ToC In ActiveDocument.TablesOfContents
ToC.Update
Next ToC
Exit Sub

[Frosty]

You're saying that if you comment out all the code related to the TOC, your document is fine?

I dont understand the logic of this snippet you've posted (maybe because it's a snipped?). I *think* you need to reorganize, first off.

Yes, the use of .InsertFile could cause issues-- but since I have no idea what kind of files these are, I don't know whether that is what is causing issue or whether it is something else.

Why are you doing things in this order?
1. opening some document for Input, using the Open command (which is a very rudimentary method-- typically used for dealing with text-only files)
2. Creating a new word document
3. Setting up some formatting for that word document
4. Setting to print view
5. Inserting a TOC
6. Cycling through the file you opened in #1
7. Doing a bunch of insertafter with some white text
8. Then inserting the entire file
9. then turning off the link to the current page footer
10. then going back to the main document
11. then going back to the current page header
12. then going back to the main document
13. Then inserting a section break
14. And then after finishing this loop.. you update (all?) the TOCs in your document?

What's going on here? Is this your main creation routine? This must be unbelievably slow on these 1000 page documents you're dealing with. How long does it take to run?

Can you take a crack at the following:
1. A function which creates a new document, with the page setup formatting that you want, and returns that document as a result of that function.
2. A Sub which turns off the .LinkToPrevious of both the headers and footers of the passed section number.
3. A sub which takes the both a document object and a path, and then does your While loop.

You are using Option Explicit, right? Because I don't know what TableNum means. I know SQL programmers don't always use prefixes for your parameters, but you really need to here, especially when posting a snippet. Type all of your variables, give them prefixes, and comment anything which isn't immediately obvious. Not just for us, but for yourself, when you come back to this routine in 3 months and don't remember a thing about it, other than "well, it USED to work."

I'm going to start you off with the structure, although I'm sure you're going to need to add some parameters.

Again, I could do this all for you, but I think you should take a crack at learning how to organize it. However, you *should* organize this, because it's going to be a big mess and very tough to troubleshoot if you don't get some organization now. There's no reason to create a TOC, then do a bunch of stuff, and then update the TOC.

I have my doubts about whether you can put a TOC at the front of this document (based on your description in the the other post) and have your page numbering remain accurate (assuming you don't want your page numbering to actually include the TOC).

I would suggest, if possible, that you put your TOC at the end of the document. However, if that isn't possible, you're going to need to adjust the page numbering function to account for how long the actual TOC is, post processing.

But that's not really addressing your first question, which is: why is this happening? The only answer I have, at the moment, is: I haven't the foggiest.

But I can get you closer to being able to solve it...



Public Sub Main()
'organize as appropriate
End Sub

Public Function fCreateDoc() As Document
Dim oDoc As Document
'do your stuff to create, format, etc
'return it
Set fCreateDoc = oDoc
End Function

Public Sub UnlinkAllInSection(oDoc As Document, iSec As Integer)
End Sub

Public Sub CreateTables(oInDoc As Document, sFromFile As String, lngFileNum As Integer)
Open sFromFile For Input As #lngFileNum
Do While Not EOF(lngFileNum)
'do stuff
Loop
End Sub

[ceilidh]

Maybe I should post the whole code...

As for what I'm doing, this is a different task than the page numbering issue. The page numbering is for different documents, I mean.

In this case, I have people who want to see various collections of tables. Each table is one Word document. Someone might ask for e.g. Table 1,7,10,11,12. So then I stick those 5 individual tables (which are 5 individual Word docs) together into one combined Word document and send it off to them.

I have a macro which works very nicely for this. And the TOC is a late addition. I'm trying to bolt a TOC onto my existing macro so that the TOC is created as the tables are stuck together. That's how I know the macro works without the TOC....

In my example above of Tables 1,7,10,11,12, the TOC would have 5 entries, one for each table. I get e.g:
Table 1........................Page1
Table 7........................Page 11
and so on. (But I don't use the page numbering macro here - I don't have to worry about within-section numbering.)

The way the macro works... using my example, those tables 1,7,10,11,12, are each a Word file in a folder. They could be in different folders. I create a little TXT file listing the filenames of these 5 Word files. The TXT file is picked up by the macro and the filenames are read in, then the macro knows which files are to be stuck together.

That Open command you said is used for dealing with TXT files..... it is dealing with a TXT file. :) In my example, the TXT file would contain 5 lines, e.g.
\project\tables\table1
\project\tables\table2
\project\tables\table3
etc...

Once the macro knows which 5 tables to stick together, it goes into a loop and sticks them all together till it runs out of filenames.

Do you remember that example doc I posted when I was asking about removing headers/footers from pages with graphs? That doc was a product of this macro... it was a few tables stuck together into one big doc with a section break between each table.

Edited to add:

Would it help more if I post the original code that sticks the word files together, without the TOC bits I've added to it? (This original code works.) For example, the "print view" you commented on is not in the original code - I added it for the TOC work.

Also, would it be better to leave the original code alone and when I've produced the final Word doc (consisting of the 5 stuck-together Word tables 1,7,10,11,12, to use my example) then run a macro to create the TOC on that final word doc? I had trouble writing VB code to create a TOC on the final Word document.... which is why I was trying to do it at the same time as sticking all the tables together.

[Frosty]

Yes and yes to your questions. Post the working code.

Then probably give a sample doc without data and how you want the TOC to work. Are the page numbers real? Are the tables spanning multiple pages? You're using a heading style with white text in order to give a TOC entry?

[Frosty]

I'm really not a fan of using the .InsertFile method, as I've seen other issues with this as well. And even if the original code is working well, you've already seen that it is difficult to modify without the whole thing breaking.

I think you should always encapsulate functionality and try (whenever possible) to separate your data-gathering elements from your doing-stuff elements.

In this case, you would simplify the troubleshooting if you were to get the data you want in one area (what file you need to insert), and then add the contents of that file to the current document in another function (obviously called within the loop)

There are a lot of reasons for this kind of modular approach:
1. You can test just the insertion process of a single table more easily... simply by running that routine (instead of modifying your text file to only have one element).

2. You more logically approach later modifications to the code (am I changing how I'm getting the file data? Am I changing what I'm doing with the inserted table? Am I doing something to the main document after I've done all my other processing? Am I creating a log file of the progress made because I've added the ability to interrupt the process?)

3. You can ask questions more easily at a forum like this, because you don't have to troubleshoot the entire 200+ lines of code -- since your function is encapsulated :)

[ceilidh]

Hi again Frosty,

Finally got some time to anonymize the tables ... OK, I'm posting everything now. Let's see...
1 - there's 3 anonymized tables, which are the 3 RTF files. Each of these comes to me in that format and I can't change them. They are my source docs, so to speak.
2 - there's 1 DOCX file which is produced by running the GLUE macro to stick the 3 RTF files together. I save the result as a DOCX. (The RTF files also still exist).
3 - there's TEST.TXT, this is where I tell GLUE what tables I want stuck together.
4 - there's an FRM/FRX file which is a little "input box" for GLUE.

[ Inserted this comment after trying to post >1 file, which I see is not allowed... I'll attach the DOCX file to this. If you want the others I listed above, let me know and I'll have to do one post per file. ]

May be more than you bargained for!
Here's the full VBA code:


Option Explicit
Public gdblTopMargin As Double
Public gdblBottomMargin As Double
Public gdblRightMargin As Double
Public gdblLeftMargin As Double
Public gdblHeaderDistance As Double
Public gdblFooterDistance As Double
Public gstrLPsetting As String
Public gstrFormButtonPressed As String


Public Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenFileName As OPENFILENAME) As Long

Public Const OFN_ALLOWMULTISELECT = &H200&
Public Const OFN_EXPLORER = &H80000
Public Const OFN_FILEMUSTEXIST = &H1000&
Public Const OFN_HIDEREADONLY = &H4&
Public Const OFN_PATHMUSTEXIST = &H800&

Sub ShowFileOpenDialog(ByRef FileList As Collection)
Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim FileDir As String
Dim FilePos As Long
Dim PrevFilePos As Long
With OpenFile
.lStructSize = Len(OpenFile)
.hwndOwner = 0
.hInstance = 0
.lpstrFilter = "Text Files" + Chr(0) + "*.txt" + _
Chr(0) + "All Files (*.*)" + Chr(0) + "*.*" + Chr(0) + Chr(0)
.nFilterIndex = 1
.lpstrFile = String(4096, 0)
.nMaxFile = Len(.lpstrFile) - 1
.lpstrFileTitle = .lpstrFile
.nMaxFileTitle = .nMaxFile
.lpstrInitialDir = "C:\"
.lpstrTitle = "Select Integration (txt) File"
.flags = OFN_HIDEREADONLY + _
OFN_PATHMUSTEXIST + _
OFN_FILEMUSTEXIST + _
OFN_EXPLORER
lReturn = GetOpenFileName(OpenFile)
' OFN_ALLOWMULTISELECT + _
If lReturn <> 0 Then
FilePos = InStr(1, .lpstrFile, Chr(0))
If Mid(.lpstrFile, FilePos + 1, 1) = Chr(0) Then
FileList.Add .lpstrFile
Else
FileDir = Mid(.lpstrFile, 1, FilePos - 1)
Do While True
PrevFilePos = FilePos
FilePos = InStr(PrevFilePos + 1, .lpstrFile, Chr(0))
If FilePos - PrevFilePos > 1 Then
FileList.Add FileDir + "\" + _
Mid(.lpstrFile, PrevFilePos + 1, _
FilePos - PrevFilePos - 1)
Else
Exit Do
End If
Loop
End If
End If
End With
End Sub


Sub Glue()
Dim strPath As String
Dim strTextLine As String
Dim strFileName As String
Dim lngFileNum As Long
Dim FileList As New Collection
Dim lngSlashLoc As Long
Dim ct As Long
Dim strLPsetting As String
Dim dblWidth As Double
Dim dblHeight As Double
On Error GoTo ErrorHandling
'Get Page Setup information first
frmPageSetup.Show
If gstrFormButtonPressed = "CANCEL" Then
Exit Sub
End If
'This will specify project path and file name
ShowFileOpenDialog FileList
With FileList
If .Count > 0 Then
ct = InStr(1, .Item(1), "\")
If ct > 0 Then
lngSlashLoc = ct
Do While ct > 0
ct = InStr(lngSlashLoc + 1, .Item(1), "\")
If ct > 0 Then
lngSlashLoc = ct
End If
Loop
End If
strPath = Left(.Item(1), lngSlashLoc - 9)
strFileName = Trim(Mid(Replace(.Item(1), Chr(0), ""), lngSlashLoc - 7))
Else
MsgBox "No file was selected!"
Exit Sub
End If
End With
'This is your page layout, landscape or portrait
'strLPsetting = InputBox("Choose Landscape or Portrait (L/P)", "Page setup")
strLPsetting = gstrLPsetting
If UCase(Trim(strLPsetting)) = "P" Then
dblWidth = 8.5
dblHeight = 11
Else
dblWidth = 11
dblHeight = 8.5
End If
' Open the relevant text file
lngFileNum = FreeFile
' This opens your text file of rtf tables to load
Open strPath & "\" & strFileName For Input As #lngFileNum
' Define the size of either a standard portrait or landscape page
Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
With ActiveDocument.PageSetup
.LineNumbering.Active = False
If UCase(Trim(strLPsetting)) = "P" Then
.Orientation = wdOrientPortrait
Else
.Orientation = wdOrientLandscape
End If
.TopMargin = InchesToPoints(gdblTopMargin)
.BottomMargin = InchesToPoints(gdblBottomMargin)
.LeftMargin = InchesToPoints(gdblLeftMargin)
.RightMargin = InchesToPoints(gdblRightMargin)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(gdblHeaderDistance)
.FooterDistance = InchesToPoints(gdblFooterDistance)
.PageWidth = InchesToPoints(dblWidth)
.PageHeight = InchesToPoints(dblHeight)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.GutterPos = wdGutterPosLeft
End With
Do While Not EOF(lngFileNum)
Line Input #lngFileNum, strTextLine
' This steps through your text file, line by line, storing the rtf table name to load
'| Loop through the files in the text file and put hem in the document with a Section Break. |
Selection.InsertFile FileName:=strPath & strTextLine, _
Range:="", ConfirmConversions:=False, _
Link:=False, Attachment:=False
'Turn off link to previous footer.
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
If Selection.HeaderFooter.LinkToPrevious = True Then
Selection.HeaderFooter.LinkToPrevious = False
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
'Turn off link to previous header.
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
If Selection.HeaderFooter.LinkToPrevious = True Then
Selection.HeaderFooter.LinkToPrevious = False
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Selection.InsertBreak Type:=wdSectionBreakNextPage
Loop
Close #lngFileNum
Exit Sub
ErrorHandling:
MsgBox "Error " & Err.Number & " occurred." & vbCrLf & vbCrLf & _
Err.Description, vbOKOnly, "Error Message"
End Sub

[Frosty]

It might be the point where you might as well post your macro template as a docm. I can't compile this code, so I could only give you generic solutions rather than troubleshoot. Your pasted code doesn't contain frmPageSetup, so I can't run it.

The forum does allow .zip files, so it may be faster, at this point, for you to provide the whole working thing, and I can troubleshoot the specific items, or use the previous attachment as your "Before" document and then post a manually modified "After" document, which I can give you some code to make happen.

I have a host of comments on the code you posted, but I'm not sure conceptual "how to approach this issue" is the most efficient way to get you up and working.

The format you've posted on the table doesn't seem to lend itself to a valid TOC (you need *something* on which to base your TOC, since everything is formatted in the Normal style). But I don't know how much you know about creating a TOC, so why don't you just try and do it manually... and I can give you code to automate that process, within the context of your above approach.

[ceilidh]

ok, trying to post a zip. This has the frm in it. And a TEST.TXT which would need to be in e.g. c:\projects\usetxts to work. (since the filenames in TEST.TXT are e.g. \tables\table1 then you'd need to have the RTF files in C:\projects\tables to work.)

If it's possible to just do a TOC for the ALL3TABLES.DOCX document, that might be best, then. Instead of trying to do it while gluing everything into ALL3TABLES.DOCX, I men.


Edited to add: zip not correct. Trying again... give me a few.
OK. I'm supposed to be playing tennis in 10 mins! I'll be back later tonight and will try the zip file again then.

[Frosty]

Got the attachment...

I'm not sure what you mean... were you attempting to create a manual TOC, with manual page numbers? Or a TOC which automatically updates, and is based on the way the document is constructed?

I've gotten confused. I think you still need to post a document, based on All3Tables.docx (I think?), which is in the state you want after running a macro (or macros).

I get that you have 1000 page document with numerous tables. Then someone requests tables x, y and z. Then you give a document with just those tables.

You want some kind of index of those tables at the top of this document, with a page number? So...

Table 1...... page 1
Table 17 .... page 5
Table 33 .... page 6

Something like that?

[ceilidh]

You got it? ok then... I thought it was corrupted, was going to recreate and resend - but I won't worry about that now if you can see all of the files.

I think if you created a dummy C:\projects\ you'd probably be able to run it all now, as you have all of the component parts. So long as the 3 RTF files are in C:\projects\tables, and the TEST.TXT file is in C:\projects\usetxts then the macro should work.


As for the TOC... I wanted to do it automatically, not manually. I wanted a TOC as the first page of the collated tables, and your comment here: "You want some kind of index of those tables at the top of this document, with a page number? So...

Table 1...... page 1
Table 17 .... page 5
Table 33 .... page 6

Something like that?" is exactly correct. I just mocked-up a doc. I only have Word 2003 on my home laptop so this is a .doc file and not a .docx, but I don't think that matters for the purposes of just showing you a shell of what I wanted to do. I'll attach the mockup to this post.

I also wanted to be able to click on the Table1.............page 1 bit and be taken to Table 1, click on the Table 33..............page 6 bit and be taken to table 33. And have the TOC automatically update when needed - if I add a page, or insert another table, can I re run the TOC macro to update or recreate the TOC...?

The page numbers are real page numbers by the way. I don't think I answered that question.

[Frosty]

I can modify your code to be a lot more simple (you're using a lot of functionality you don't really need to use -- the private declare for getting a File Select dialog is actually built in functionality-- you don't need to use comdlg32.dll just for that purpose), but the crux of it is that I still don't know how you really want to create your TOC. You can't just type it out-- it won't be dynamic.

"Real" TOCs rely on one of two methodologies:
1. Style based (where you apply a style, typically Heading 1 for these purposes) to a paragraph... and then TOC field puts every paragraph styled with that style into a field, with associated page numbers for the paragraphs thusly styled. The advantage to this method is that it is easy to maintain your document, simply by styling the paragraphs you want in your TOC... and if you add new content, then you just right-click and update the TOC.

2. "Marked" TOCs, where you mark some text with a field code, and the TOC then displays any paragraphs with those TOCs. This is more laborious, because the text that displays in the TOC is actual text contained in the field, rather than whatever you change the text of a styled paragraph to. So if you change the text of a paragraph you want in the TOC, you *also* have to change the text in the field code contained in that paragraph.

The trouble with your document is that your table titles are in headers-- which isn't an allowed place to have either a style or a marked table of contents entry.

So, I think you need to mark your tables manually in a single process.

So, 2 questions:

1. Do you know, for sure, that the text of the last two cells in the header are the content you want in your table of contents (i.e., those are your table titles, always?)

2. Can the first cell of the actual tables have a hidden field added to it, for the purposes of the TOC? You're not modifying these tables in any way, are you? You just might be adding a few tables to the document?

Basically, what I'm going to construct is going to be breakable in a couple of different ways, depending on what you're planning on doing with these documents *after* this creation process... so I'm not sure how you want to go about it. Here is a manual representation of what we would do through code. You'll need to make sure you turn paragraph marks on and reveal field codes so you can see what's going on.

[Frosty]

This is a completely redesigned version of your code... it's easier to build it right than try to handle what you've frankensteined together (no offense). I think this also will show others that modularizing your code is really really useful.

While this code isn't complete on it's own (because it still uses your frmPageSetup), anyone else could easily comment that out, and simply hardcode the values they desired.

That said-- there is one major concept you're missing here in your design.

You don't need to create public variables as "holders" of form data. Just use the values of the appropriate form controls before you unload the form. You still have access to them, even after you've hidden the form. Don't have code inside forms to unload themselves... it adds work to your programming.

So instead of setting a public string value to "P" or "L" based on the option selected on the form (portrait vs. landscape), just use the .Value property of that actual control (there's a demo of that in the code below).

Here is the code... you should be able to create a new module in your existing project, paste this all in, and it will work for you.

Another development concept-- just like you have the immediate window to test SQL queries, you have an immediate window in the VBA editor. Use it, it's really helpful... the hardest part of coding this was getting the table title from your headers-- since it isn't consistent.

With a modular approach, I can tweak double click the header, place my cursor in the table... and then in the immediate window type
?fGetTableTitle(Selection.Tables(1))

I can either see the result, or I can put a break point in the function to see if I'm getting the values I need. Try it... it's a very good way to instinctively build modular code.

Let us know how it goes.


Option Explicit

'the folder containing the load files
Public Const PATH_LOADFILE As String = "F:\Consulting\Development\glue"
'Main routine to do
'1. capture the text file contents for which files to insert
'2. create a document to insert the files into
'3. Format that document, according to the user form
'3. Create a TOC on this document, based on a specific set of critiera

Public Sub UI_Main()
Dim sLoadFileFullName As String
Dim aryFilesToInsert() As String
Dim oNewDoc As Document
Dim i As Integer
Dim rngInsert As Range
'use a function to retrieve the load file name and path
sLoadFileFullName = fGetPath_FileDialog(PATH_LOADFILE, "Select Load File...")
If sLoadFileFullName = "" Then
GoTo l_exit
End If
'use a function to return an array of files to insert
aryFilesToInsert = fGetArrayOfFilesToInsert(sLoadFileFullName)
Set oNewDoc = fGetNewDocFormatted
'if we didn't return a document, we're done
If oNewDoc Is Nothing Then
GoTo l_exit
End If
'now loop through our array, to insert our tables from the documents
For i = 0 To UBound(aryFilesToInsert)
'manipulate the range
Set rngInsert = oNewDoc.Content
rngInsert.Collapse wdCollapseEnd
'don't worry about inserting a section on the first iteration
If i > 0 Then
rngInsert.Sections.Add rngInsert
Set rngInsert = oNewDoc.Content
rngInsert.Collapse wdCollapseEnd
oNewDoc.Sections.Last.Headers(wdHeaderFooterPrimary).LinkToPrevious = False
oNewDoc.Sections.Last.Footers(wdHeaderFooterPrimary).LinkToPrevious = False
End If
rngInsert.InsertFile aryFilesToInsert(i), , False
Next
'now build our TOC with this document
BuildTOC oNewDoc
l_exit:
Exit Sub
End Sub

'Marks and builds the TOC for the document, inserting a section to do so

Public Sub BuildTOC(oDoc As Document)
Dim rngInsert As Range'first, we need to insert our TOC section at the beginning
oDoc.Sections.Add oDoc.Content
'set the second section to no same as previous, restarting the page numbering
With oDoc.Sections(2).Headers(wdHeaderFooterPrimary)
.LinkToPrevious = False
.PageNumbers.RestartNumberingAtSection = True
.PageNumbers.StartingNumber = 1
End With
'set up our first section
With oDoc.Sections(1)
'clear our the header with our own text
With .Headers(wdHeaderFooterPrimary).Range
.Text = "TABLE OF CONTENTS"
.Font.Size = 16
.Font.Bold = True
.ParagraphFormat.Alignment = wdAlignParagraphCenter
End With
End With
'now we need to mark our TOC entries...
MarkForTOC oDoc
'now create the table of contents
Set rngInsert = oDoc.Sections(1).Range
rngInsert.Collapse wdCollapseStart
oDoc.TablesOfContents.Add Range:=rngInsert, _
RightAlignPageNumbers:=True, _
UseHeadingStyles:=False, _
UseFields:=True, _
TableID:="C", _
IncludePageNumbers:=True, _
AddedStyles:="", _
UseHyperlinks:=True, _
HidePageNumbersInWeb:=True, _
UseOutlineLevels:=False
'and format it
oDoc.TablesOfContents(1).TabLeader = wdTabLeaderDots
oDoc.TablesOfContents.Format = wdIndexIndent
End Sub

'very specific criteria to mark for our table of contents, and then put the field in the document

Public Sub MarkForTOC(oDoc As Document)
Dim oSec As Section
Dim rngWhere As Range
Dim oTable As Table
Dim sTableEntryText As String
For Each oSec In oDoc.Sections
If oSec.Headers(wdHeaderFooterPrimary).Range.Tables.Count > 0 Then
'get the table in the header, which contains our table title info
sTableEntryText = fGetTableTitle(oSec.Headers(wdHeaderFooterPrimary).Range.Tables(1))
'now that we have the table title, we need a place to insert it.
'first cell of the actual table seems good
'set and collapse the range
Set oTable = oSec.Range.Tables(1)
Set rngWhere = oTable.Cell(1, 1).Range
rngWhere.Collapse wdCollapseStart
'insert the field
'rngWhere.Fields.Add rngWhere, wdFieldTOCEntry, sTableEntryText, False
'rngWhere.Fields.Add rngWhere, wdFieldEmpty, "TC ""Table - xxxxxxxxx"" ", False
rngWhere.Fields.Add rngWhere, wdFieldEmpty, "TC """ & sTableEntryText & """ ", False
End If
Next
End Sub

'return the table title from the table

Public Function fGetTableTitle(oTable As Table) As String
Dim rngWhere As Range
Dim sRet As String
Dim oCell As Cell
With oTable.Range
'start at the last cell, and move backwards until our first non-empty cell
Set oCell = .Cells(.Cells.Count)
Do Until Replace(oCell.Range.Text, Chr(13) & Chr(7), "") <> ""
Set oCell = oCell.Previous
Loop
Set rngWhere = oCell.Range
'get the text of this cell, ignoring the special end of cell marker
sRet = Replace(rngWhere.Text, Chr(13) & Chr(7), "")
'get the previous cell
Set rngWhere = oCell.Previous.Range
sRet = " - " & sRet
sRet = Replace(rngWhere.Text, Chr(13) & Chr(7), "") & sRet
End With
fGetTableTitle = sRet
End Function

Use a function to return a properly formatted document

Public Function fGetNewDocFormatted() As Document
Dim f As frmPageSetup
Dim oDocRet As Document
'userform for purposes of getting page set up info
Set f = New frmPageSetup
f.Show
'if cancelled, we're done (use a public property of the form, rather than a public variable)
If gstrFormButtonPressed = "CANCEL" Then
'If f.blCancel = True Then
GoTo l_exit
End If
'create a new document
Set oDocRet = Documents.Add(Template:="Normal", NewTemplate:=False, DocumentType:=0)
'format it based on the values of the form (don't need all those global variables as middlemen)
With oDocRet.PageSetup
.LineNumbering.Active = False
'if the value of our form indicates the landscape option was selected, then use that
If f.optLandscape.Value = True Then
.Orientation = wdOrientLandscape
Else
.Orientation = wdOrientPortrait
End If
'I leave the rest to you to work out
' .TopMargin = InchesToPoints(gdblTopMargin)
' .BottomMargin = InchesToPoints(gdblBottomMargin)
' .LeftMargin = InchesToPoints(gdblLeftMargin)
' .RightMargin = InchesToPoints(gdblRightMargin)
' .Gutter = InchesToPoints(0)
' .HeaderDistance = InchesToPoints(gdblHeaderDistance)
' .FooterDistance = InchesToPoints(gdblFooterDistance)
' .PageWidth = InchesToPoints(dblWidth)
' .PageHeight = InchesToPoints(dblHeight)
' .FirstPageTray = wdPrinterDefaultBin
' .OtherPagesTray = wdPrinterDefaultBin
' .SectionStart = wdSectionNewPage
' .OddAndEvenPagesHeaderFooter = False
' .DifferentFirstPageHeaderFooter = False
' .VerticalAlignment = wdAlignVerticalTop
' .SuppressEndnotes = False
' .MirrorMargins = False
' .TwoPagesOnOne = False
' .GutterPos = wdGutterPosLeft
End With
l_exit:
'return the doc
Set fGetNewDocFormatted = oDocRet
Exit Function
End Function

Get the array of files to insert from the path passed

Public Function fGetArrayOfFilesToInsert(sLoadFilePath As String) As Variant
Dim oLoadFile As Document
Dim aryRet() As String
Dim i As Integer
Dim oPara As Paragraph
On Error GoTo l_err
'initialize our return array
ReDim Preserve aryRet(i)
'open the file invisibly
Set oLoadFile = Documents.Open(FileName:=sLoadFilePath, ConfirmConversions:=False, Visible:=False)
'go through each paragraph in the load file, adding the items to an array
For Each oPara In oLoadFile.Paragraphs
'if we've got something other than a paragraph, load the file path
If Len(oPara.Range) > 1 Then
ReDim Preserve aryRet(i)
'get the text
aryRet(i) = oPara.Range.Text
'replace any chr(13) or chr(10)s
aryRet(i) = Replace(aryRet(i), Chr(13), "")
aryRet(i) = Replace(aryRet(i), Chr(10), "")
'KLUGE to get path -- may need to be adjusted
'basically takes the path of the load file minus application seperator, and puts the load file in
aryRet(i) = Left(sLoadFilePath, InStrRev(sLoadFilePath, "\") - 1) & aryRet(i)
i = i + 1
End If
Next
l_exit:
'return the array
fGetArrayOfFilesToInsert = aryRet
'return the array and do clean up
On Error Resume Next
oLoadFile.Saved = True
oLoadFile.Close
Exit Function
l_err:
'ignore errors, return the array
Resume l_exit
End Function

Get a path using the FileDialog

Public Function fGetPath_FileDialog(Optional sInitialFileName As String, _
Optional sTitle As String = "Select File...") As String
Dim oFD As FileDialog
Dim sRet As String
Set oFD = Application.FileDialog(msoFileDialogFilePicker)
With oFD
'defaults
.AllowMultiSelect = False
'ask for all of our project paths
.Title = sTitle
.InitialFileName = sInitialFileName
.Filters.Add "Text", "*.txt", 1
If .Show = -1 Then
sRet = .SelectedItems(1)
End If
End With
fGetPath_FileDialog = sRet
End Function

[ceilidh]

I can modify your code to be a lot more simple (you're using a lot of functionality you don't really need to use -- the private declare for getting a File Select dialog is actually built in functionality-- you don't need to use comdlg32.dll just for that purpose), but the crux of it is that I still don't know how you really want to create your TOC. You can't just type it out-- it won't be dynamic.

"Real" TOCs rely on one of two methodologies:
1. Style based (where you apply a style, typically Heading 1 for these purposes) to a paragraph... and then TOC field puts every paragraph styled with that style into a field, with associated page numbers for the paragraphs thusly styled. The advantage to this method is that it is easy to maintain your document, simply by styling the paragraphs you want in your TOC... and if you add new content, then you just right-click and update the TOC.

2. "Marked" TOCs, where you mark some text with a field code, and the TOC then displays any paragraphs with those TOCs. This is more laborious, because the text that displays in the TOC is actual text contained in the field, rather than whatever you change the text of a styled paragraph to. So if you change the text of a paragraph you want in the TOC, you *also* have to change the text in the field code contained in that paragraph.

The trouble with your document is that your table titles are in headers-- which isn't an allowed place to have either a style or a marked table of contents entry.

So, I think you need to mark your tables manually in a single process.

So, 2 questions:

1. Do you know, for sure, that the text of the last two cells in the header are the content you want in your table of contents (i.e., those are your table titles, always?)

2. Can the first cell of the actual tables have a hidden field added to it, for the purposes of the TOC? You're not modifying these tables in any way, are you? You just might be adding a few tables to the document?

Basically, what I'm going to construct is going to be breakable in a couple of different ways, depending on what you're planning on doing with these documents *after* this creation process... so I'm not sure how you want to go about it. Here is a manual representation of what we would do through code. You'll need to make sure you turn paragraph marks on and reveal field codes so you can see what's going on.

I just had a look at your document, with the TOC attached. That would be perfect, that TOC, if there were a way to do it programmatically.

Yes, my code is clunky, I know, I'm picking up VB on the fly and studying it out of books and on this forum too, now. I think I can only write any VB code at all right now because I do program in SQL - so have some programming background - but I'm under no illusions whatsoever that my VB code is clunky and probably much too long and inefficient. Hopefully I'll improve as I get more practice and study more code. That's how I mastered SQL eventually - though it took months of lots of study and practice.

And, for your two questions, the answers are:
1. The titles I want in the TOC will usually be the last 2 rows in the header, yes. On the occasions where it is not, I'd guess I'll just manually edit the text in the TOC. This happens rarely enough not to matter if I do end up editing for the few tables where the titles I want are not in the last 2 rows.
2. The first cell of the actual tables can sometimes have text in it. So long as the text isn't wiped (when it exists) then there's no reason why the first cell can't have a hidden field added.

And no, I don't modify the tables once they are stuck into the documents with a TOC on it. I need to add new tables sometimes, but I don't change the existing tables. They're final by the time they get to that point of being pulled out for reference purposes.

As for your question about how I want to create the TOC out of the two ways you described.... the answer to that is that I honestly don't know which would be best at this point - which one would give me the TOC you've demonstrated in your attachment... I don't know enough about the TOC code really. Another thing I will have to study. It looks like, from what you say, the second way is going to be the one needed, but again, I don't know enough. I think I'll have to rely on your guidance for that one.

[ceilidh]

I've just started studying your code in your latest reply. No feedback yet... I have to put it in to my VBA and step through it to see what it does. I agree modular approaches are good though, it's just that I'm not familiar enough with VB to write elegant code yet. Been using it for only a month! Ever since I got handed these documents to keep and organize.....

In SQL, I often write one chunk of code and store it somewhere, then pull it when needed into other programs. For example, if I have to check that a date is valid. I have a chunk of code that checks that a date is valid. And I just call that code in any program whenever I need to check e.g. start date is a valid date, stop date is a valid date, date the front door of the house was painted is a valid date, and so on.

I am still very shaky when it comes to structuring VB code this way though. From looking at your code, I'm beginning to think any individual task in VB could be spun off into a small module. Then the program itself is much shorter and is calling a lot of modules... very interesting.

I love the immediate window in SQL :) how do I bring it up in VBA? Right now I am using F8 to step through the code to check where it breaks and I get errors...

One question right now, this bit at the top of your code, do I need this or is it specific to your machine? I'm thinking the F:\ folder you've specified is one you created to put all this in, that this is where you put the RTF files.

'the folder containing the load files
Public Const PATH_LOADFILE As String = "F:\Consulting\Development\glue"

[Frosty]

That constant you can manipulate to do be whatever you want... something on the C:\ is where you would want to change it to.

That was the file path to where I had Test.txt stored.

I'm traveling for a few days, but the issues with the code I gave you will be the following:

1. Running the TOC creation process on a document which already has field codes-- it doesn't currently check to see if they are already there. But that would be trivial to add.

Other than that, I think it will do what you want it to do. Study it a bit, and then ask your questions.

Good luck!

[ceilidh]

Hi again,

I spent a lot of today studying the code. I used F8 to execute line by line and watch what it was doing, too... that always helps.

It's working for me :) so that's good! But I do have a couple questions...

My first question relates to your first question to me, when you asked "1. Do you know, for sure, that the text of the last two cells in the header are the content you want in your table of contents (i.e., those are your table titles, always?)".

I thought that question meant that we'd only ever get 2 of the titles from the header. But when I read your code, it looks like you've planned to pick up any number of titles. (from your comment, too - about working back from the first non-empty cell till you run out of cells). I can't actually see the bit where you limited it to two titles. In effect, it IS picking up just two titles, but the code seems to be asking for them all, so it's puzzling me - I'm sure that's just because I don't understand all of it. This is the code I'm talking about:


'return the table title from the table
Public Function fGetTableTitle(oTable As Table) As String
Dim rngWhere As Range
Dim sRet As String
Dim oCell As Cell
With oTable.Range
'start at the last cell, and move backwards until our first non-empty cell
Set oCell = .Cells(.Cells.Count)
Do Until Replace(oCell.Range.Text, Chr(13) & Chr(7), "") <> ""
Set oCell = oCell.Previous
Loop
Set rngWhere = oCell.Range
'get the text of this cell, ignoring the special end of cell marker
sRet = Replace(rngWhere.Text, Chr(13) & Chr(7), "")
'get the previous cell
Set rngWhere = oCell.Previous.Range
sRet = " - " & sRet
sRet = Replace(rngWhere.Text, Chr(13) & Chr(7), "") & sRet
End With
fGetTableTitle = sRet
End Function


And my other question relates to your second question to me: '2. Can the first cell of the actual tables have a hidden field added to it, for the purposes of the TOC?' I'm ok with a hidden field added to the first cell of the table, no problem there... however, the field isn't hidden. I can see it in the first cell right before the text that is already in the first cell. For example, I see this:

{..TC.. Table 1..xxxx..}YYYY in the first cell of my table, where the xxxx is the returned table title from running the macro and the YYYY is the existing text in the table cell. Can we make that hidden field truly hidden? So that all that is visible is the YYYY bit?

I'm sure I'll have more questions yet as I'm still trying to understand all of it - these are just the first!

However, I thought it'd be good news to hear that it does work! If the hidden fields are actually hidden and not visible, it will be perfect. Most of my questions at this point are really from wanting to understand the code and how it is working. (That is, "How is it working" rather than "How do I get it to work"....)

[Frosty]

That bit of code works backwards until it finds a non empty cell, grabs that text, and then grabs the text of the previous cell. So you're just getting two cells. We can modify it to deal with multiple scenarios, but that's what it does right now.

For the fields that are visible. They will go away if you turn off your paragraph marks. They also won't print out. But not sure of that's good enough for your purposes.

[Frosty]

Oh, and if it isn't, we could handle that, but it would require a bit more coding to, and the TOC wouldn't be dynamic

[ceilidh]

I pulled out my work computer this morning for another go at figuring out the code.

I see the fGetTableTitle intent now... neat idea, work backwards till you get to the last title then start concatenating titles. Very neat. You mentioned amending it... is it possible to have it search for potential 3rd titles? I have several groups of tables, many of which have only 2 titles. But some of them have 3. Only some, not all. If it's not possible to search for a potential 3rd title, then no worries, because as I mentioned before for those few tables where the 3rd title appears, I can manually edit the title in the TOC and the field code. There's not enough of them for that to be a serious hassle.

I just tried turning off my paragraph marks (and other formatting) and the field codes went hidden too. Great! So they are only visible when I turn on the paragraph marks, and not visible otherwise. And I just printed 1 page - they don't print out. That is perfect. No need for any edits... especially if it removes the dynamism when that's not needed.

I do have one problem I didn't anticipate, though. I have a few graphs that I have to glue up with these tables sometimes. The graph is a pictorial representation of the data in the table - it's always associated with a table. Because of this, I don't care if the graph is listed in the TOC or not, if it's not listed in the TOC it doesn't matter as long as it's associated table is listed (which it is). However... the problem is that the code is looking for a table on the page, to insert a field code, and if it doesn't find a table in the page (because the page has a graph which is a picture object) then it stops working at that point. Is it possible to have the code just ignore any page without a table on it, rather than stop working...? I think it's this bit of the code where this is happening:


Public Sub MarkForTOC(oDoc As Document)
Dim oSec As Section
Dim rngWhere As Range
Dim oTable As Table
Dim sTableEntryText As String
For Each oSec In oDoc.Sections
If oSec.Headers(wdHeaderFooterPrimary).Range.Tables.Count > 0 Then
'get the table in the header, which contains our table title info
sTableEntryText = fGetTableTitle(oSec.Headers(wdHeaderFooterPrimary).Range.Tables(1))
'now that we have the table title, we need a place to insert it.
'first cell of the actual table seems good
'set and collapse the range
Set oTable = oSec.Range.Tables(1)
Set rngWhere = oTable.Cell(1, 1).Range
rngWhere.Collapse wdCollapseStart
'insert the field
'rngWhere.Fields.Add rngWhere, wdFieldTOCEntry, sTableEntryText, False
'rngWhere.Fields.Add rngWhere, wdFieldEmpty, "TC ""Table - xxxxxxxxx"" ", False
rngWhere.Fields.Add rngWhere, wdFieldEmpty, "TC """ & sTableEntryText & """ ", False
End If
Next
End Sub


And, you were correct about using modules making things easier. It is a lot easier to look at this piece by piece and figure it out!

[Frosty]

Definitely easy enough to adjust the get title function, just need a couple of sample tables in a document. Then you can manipulate the function until it handles any of the sample tables you throw at it.

Regarding the graphics, I'm assuming those are in their own section as well? Otherwise, I'm not sure why it would break... But it would be safer, regardless, to bracket all the code referring to the first table with an if statement that makes sure the .Tables.Count of the section is greater than 0.

[ceilidh]

Yes, the graphics are in their own section as well. A one-page section, containing just one page with one graph, usually. I thought the module was looking for a table so it could insert the field code into the first cell, and when it didn't find a table (because the only thing on the graphics page is a picture object) then that was when it errored-out.

Out of curiosity... is there a way to insert a field code inside a picture object? Or is that impossible/very hard? I'm currently assuming it's impossible. (like I said, I don't really care if the graph is listed in the TOC or not - this is just curiosity.)

Do you want me to post more tables with the different titles? (the ones with 3 titles...) They are essentially the same as the ones you have, just have one extra title line... The ones you have are laid out like this:

Table 1
xxxxxxxxxxxxxxxxxxxx

and the ones with three titles are laid out like this:

Listing 1
xxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx


(even though it says "listing", it's a table in that the data is still contained within table gridlines... the only real difference between tables and listings is that the listings contain more text data while the tables contain more numeric data!)

[Frosty]

Sounds like we're aiming for two changes.
1. Modify the get title function to get from three cells, if they aren't blank.

2. Add the graphic to the TOC as well. You can't insert the field code into the actual graphic, but you could certainly insert it into the paragraph the graphic is in (or anchored to).

In answer to your question... The function just assumes the first table in the section. If there isn't a table, then it's going to error. So you can avoid that error by checking to see if there is a table before assuming there is one (by checking the .Tables.Count property before making the assumption with the .Tables(1) line of code.

Why don't you take a crack at modifying the function, and then I can comment? Since I don't have access to a computer to write the code, this seems expedient as well as learning opportunity for you.

[ceilidh]

Thanks Frosty! Yes, I'll have a go tonight right after dinner. I'll try modifying the function to check for a table before assuming there is one, first, and then post the code when it's working. (if I manage to get it working!!!)

[Frosty]

The only thing that isn't teachable is the willingness to try. Thanks for bringing that to the table. The rest of it is just time in the saddle, so to speak.

[ceilidh]

It works!!! Here's the edited code with the lines edited in red:


Public Sub MarkForTOC(oDoc As Document)
Dim oSec As Section
Dim rngWhere As Range
Dim oTable As Table
Dim sTableEntryText As String
For Each oSec In oDoc.Sections
If oSec.Headers(wdHeaderFooterPrimary).Range.Tables.Count > 0 Then
'get the table in the header, which contains our table title info
sTableEntryText = fGetTableTitle(oSec.Headers(wdHeaderFooterPrimary).Range.Tables(1))
'now that we have the table title, we need a place to insert it.
'first cell of the actual table seems good
'set and collapse the range
If oSec.Range.Tables.Count > 0 Then
Set oTable = oSec.Range.Tables(1)
Set rngWhere = oTable.Cell(1, 1).Range
rngWhere.Collapse wdCollapseStart
'insert the field
'rngWhere.Fields.Add rngWhere, wdFieldTOCEntry, sTableEntryText, False
'rngWhere.Fields.Add rngWhere, wdFieldEmpty, "TC ""Table - xxxxxxxxx"" ", False
rngWhere.Fields.Add rngWhere, wdFieldEmpty, "TC """ & sTableEntryText & """ ", False
End If
End If
Next
End Sub


Now I think I might try the fGetTableTitle edit to look for that 3rd title. I may run into trouble what that one. But I'll have a go. (not too sure how to say "get another previous title" after it's already retrieved one previous title. Not too sure if I'd break it by having it look for a 3rd title, then it comes to a table that only has 2 titles not 3... but I'll see what I can do and post the code after.)

[ceilidh]

OK, I did run into trouble with fGetTableTitle. Tried a few things... either they had no effect, or I got "Table 1 - Table 1 - XXXXXXXXXX' or the macro took so long to run that I ended it without it finishing.

Here's the code I thought had the best chance of working - it doesn't though - just ran so long that I gave up on it and crashed the program to stop it running.

I was trying to propagate the concept you'd had - where you start at the last cell and move backwards till the first non-empty cell, then retrieve the text from that non-empty cell plus the preceding one. I thought I could continue that concept and have the function keep moving through the titles until it came to an empty cell or it ran out of cells. Then stop. That way it'd move backwards to get 2 titles for the tables, then stop. And move backwards to get 3 titles for the listings, then stop. And for the graphs, there are no empty cells so it would have to stop at the last cell. (graph headers are tables consisting of 2 rows with 2 cells in each row - none empty. If we can add graphs... have to cater for their titles also...)

The lines marked *** are the ones I tried. I tried other things, but just posting this one thing because it seems to me it should have worked and I don't understand why it didn't...


Public Function fGetTableTitle(oTable As Table) As String
Dim rngWhere As Range
Dim sRet As String
Dim oCell As Cell
With oTable.Range
'start at the last cell, and move backwards until our first non-empty cell
Set oCell = .Cells(.Cells.Count)
Do Until Replace(oCell.Range.Text, Chr(13) & Chr(7), "") <> ""
Set oCell = oCell.Previous
Loop
Set rngWhere = oCell.Range
'get the text of this cell, ignoring the special end of cell marker
sRet = Replace(rngWhere.Text, Chr(13) & Chr(7), "")
Do Until Replace(oCell.Previous.Range.Text, Chr(13) & Chr(7), "") = ""
'get the previous cell until the last non-empty cell
Set rngWhere = oCell.Previous.Range
sRet = " - " & sRet
sRet = Replace(rngWhere.Text, Chr(13) & Chr(7), "") & sRet
Loop
End With
fGetTableTitle = sRet
End Function

[Frosty]

Well, you don't have an iterator in your Do Until... Loop.

Sure, you're setting your rngWhere = oCell.Previous.Range.... but no where did you iterate to the previous Cell by using something like Set oCell = oCell.Previous (as the first Do Until... Loop does).

This is where the immediate window becomes useful when stepping through code... you'll see that in each iteration of your second Do loop, your'd see your rngWhere text is the same.

In fact, that's the time to type the following in the immediate window...
rngWhere.Select

When I'm unclear if things are operating the way I think, as I step through the code, I will typically do things like...
oCell.Range.Select
rngWhere.Select
?rngWhere.Text

etc... just so I get some immediate feedback (whether in the code window or in the actual document) on what I'm working on.

Other than that, I *think* your concept of what will work sounds right for the three table types you've described.

However, wanted to point out one other concept in terms of Do loops (where you have to manually increment your iterator, whatever it is) and For loops (where the iterator is incremented for you, by the design of your statement).

You often should still have an additional bit of criteria to exit out of your loop, whether to prevent infinite loops/errors, or to make your code more efficient.

So I would modify the original Do... Loop to be this...


Do Until Replace(oCell.Range.Text, Chr(13) & Chr(7), "") <> ""
If oCell.Previous is Nothing Then
Exit Do
Else
Set oCell = oCell.Previous
End If
Loop

That gives an extra bit of an "escape" to that, no matter what, you don't cause an error if your criteria isn't met before you get to the end (start) of your table.

And for the second Do...Loop, you will want to handle that as well, in some way.

[ceilidh]

The edit to the table title function is working! Thanks for the oCell tip.

I'm using the immediate window now. Very neat. I was able to see all my titles as they were pulled, in order - it did help, as I also realized I was using "previous.previous" instead of just "previous" and missing out a title.

Here's the code now, with my edits. It pulls out every title from the first non-empty cell till the last non-empty cell.



Public Function fGetTableTitle(oTable As Table) As String
Dim rngWhere As Range
Dim sRet As String
Dim oCell As Cell
Dim dRet As String
With oTable.Range
'start at the last cell, and move backwards until our first non-empty cell
Set oCell = .Cells(.Cells.Count)
Do Until Replace(oCell.Range.Text, Chr(13) & Chr(7), "") <> ""
If oCell.Previous Is Nothing Then
Exit Do
Else
Set oCell = oCell.Previous
End If
Loop
Set rngWhere = oCell.Range
'get the text of this cell, ignoring the special end of cell marker
sRet = Replace(rngWhere.Text, Chr(13) & Chr(7), "")
'get the previous cell until the last non-empty cell
Do Until Replace(oCell.Previous.Range.Text, Chr(13) & Chr(7), "") = ""
If oCell.Previous Is Nothing Then
Exit Do
Else
Set oCell = oCell.Previous
End If
Set rngWhere = oCell.Range
sRet = " - " & sRet
sRet = Replace(rngWhere.Text, Chr(13) & Chr(7), "") & sRet
Loop
End With
fGetTableTitle = sRet
End Function


So now the only edit is somehow include the graphics in the TOC. These are in their own section as I mentioned, but are picture objects on a page not a table. Currently the macro just skips over graphs completely because it is now looking for a table to embed the field code in the first cell.

Oh, maybe a dumb question here... but, my VBA seems to have developed a hangup. When I run the TOC macro now, the VBA window pops up and in the top of the window it says [break]. When I select "Run" and "Continue" then it will continue running all the way to the end and gives me the TOC. Why does it [break] like this and require Run -> Continue, when it didn't before? (code still works. TOC still perfect. Just would like to run the macro without the VBA window popping open and the macro stopping, unless I open the window to run it using F8)

[Frosty]

Do you have the option to hit the Debug button? If you don't, then did you start using this as a global addin?

You might have turned on your error handling to Break on All Errors (VBA Editor > Tools > Options > General > Error Trapping area, or you might have a break point in your template. Or you could have put "Stop", although that's generally obvious.

If you step through the whole macro (and know that you can use Shift + F8 to step "over" areas of the macro you know work, or CTRL+SHIFT+F8 to step back out of a macro you stepped into that you know works, or even set breakpoints to run all the way to that spot).

For the graphics in the TOC... It's a matter of adjusting your If statement where you skip over a section that doesn't have any tables to include an Else area. And in that Else area, you would handle other types of sections. So something along the lines of...

If .Tables.Count > 0 Then
Else
'Attempt to deal with non-tabled sections here
End If

Of course, I would recommend having a separate routine that deals with that... but you would need to capture the table title from that section as well, and then insert the field code that the TOC would use, but at the very beginning of that section, rather than in the first cell of the table.

Do you want to try, or do you want to post the entirety of the code you're working with, as well as a sample document which includes the different table headers you're using, as well as a few sections, at least one of which has a sample graphic.

No need to worry about all the disparate parts... since we aren't concerned with constructing the document from .InsertFile, but rather dealing with the document as constructed.

[ceilidh]

I'm working on getting a couple of the graphs anonymized so I can post a document with 2 graphs. It's hard work because of the way these graphs are constructed. I won't have them ready till tomorrow. I'm working at home tomorrow afternoon so I'll get the doc finished and post it then.

[ceilidh]

Okay Frosty, I'm sorry you had to wait for this. Becuase of the way the graphs are constructed it was harder to anonymize a couple than I originally thought. I ended up having to recreate them with scrambled data and xxxxx'd out text in their creation program. Ugh! So anyway, here's the doc you asked for, attached to this in a zip file to help with upload speed.

This is a doc that has been through the insert file process and is the complete doc ready for the TOC to be created. For right now, I'm not working with (or posting) the bit of code where this doc is constructed because (a) it wors fine and (b) there's not edits to make to it. What I'm doing is working with the code only from BuildTOC onwards as if it was self-contained and not callable through the document construction code. I wanted to keep it manageable when I was stepping through with F8 and the immediate window.

So, here's the code I'm using for now. It works as intended - produces a TOC for all files except the graphics. What I want to do is add the graphics to the TOC. I'm not sure how to do this. And the text of their titles is weird... you'll see what I mean when you open the file and look. It may be that I just have to settle for adding the graphs to the TOC, then manually editing the field code to put the graph titles in the TOC but anything you could do would be fantastic...!


Public Sub BuildTOC()
Dim oDoc As Document
Dim rngInsert As Range
Set oDoc = ActiveDocument
'First, insert a TOC section at the beginning
ActiveDocument.Sections.Add ActiveDocument.Content
'Set the second section to not link to previous, and restart the page numbering
With ActiveDocument.Sections(2).Headers(wdHeaderFooterPrimary)
.LinkToPrevious = False
.PageNumbers.RestartNumberingAtSection = True
.PageNumbers.StartingNumber = 1
End With
'Set up the first section
With oDoc.Sections(1)
'Clear out the header, substitute our own text
With .Headers(wdHeaderFooterPrimary).Range
.Text = "TABLE OF CONTENTS"
.Font.Size = 16
.Font.Bold = True
.ParagraphFormat.Alignment = wdAlignParagraphCenter
End With
End With
'Now we need to mark the TOC entries, call the subroutine for this
MarkForTOC oDoc
'Now create the table of contents...
Set rngInsert = oDoc.Sections(1).Range
rngInsert.Collapse wdCollapseStart
oDoc.TablesOfContents.Add Range:=rngInsert, _
RightAlignPageNumbers:=True, _
UseHeadingStyles:=False, _
UseFields:=True, _
TableID:="C", _
IncludePageNumbers:=True, _
AddedStyles:="", _
UseHyperlinks:=True, _
HidePageNumbersInWeb:=True, _
UseOutlineLevels:=False
'...and format it
oDoc.TablesOfContents(1).TabLeader = wdTabLeaderDots
oDoc.TablesOfContents.Format = wdIndexIndent
End Sub

Specific criteria to mark for our table of contents, and then put the field in the document

Public Sub MarkForTOC(oDoc As Document)
Dim oSec As Section
Dim rngWhere As Range
Dim oTable As Table
Dim sTableEntryText As String
For Each oSec In oDoc.Sections
If oSec.Headers(wdHeaderFooterPrimary).Range.Tables.Count > 0 Then
'get the table in the header, which contains our table title info - call the function for this
sTableEntryText = fGetTableTitle(oSec.Headers(wdHeaderFooterPrimary).Range.Tables(1))
'now that we have the table title, we need a place to insert it.
' using first blank line for now - revisit
'set and collapse the range
If oSec.Range.Tables.Count > 0 Then
Set oTable = oSec.Range.Tables(1)
Set rngWhere = oTable.Cell(1, 1).Range
rngWhere.Collapse wdCollapseStart
'insert the field
'rngWhere.Fields.Add rngWhere, wdFieldTOCEntry, sTableEntryText, False
'rngWhere.Fields.Add rngWhere, wdFieldEmpty, "TC ""Table - xxxxxxxxx"" ", False
rngWhere.Fields.Add rngWhere, wdFieldEmpty, "TC """ & sTableEntryText & """ ", False
End If
End If
Next
End Sub

Return the table title from the table

Public Function fGetTableTitle(oTable As Table) As String
Dim rngWhere As Range
Dim sRet As String
Dim oCell As Cell
Dim dRet As String
With oTable.Range
'start at the last cell, and move backwards until our first non-empty cell
Set oCell = .Cells(.Cells.Count)
Do Until Replace(oCell.Range.Text, Chr(13) & Chr(7), "") <> ""
If oCell.Previous Is Nothing Then
Exit Do
Else
Set oCell = oCell.Previous
End If
Loop
Set rngWhere = oCell.Range
'get the text of this cell, ignoring the special end of cell marker
sRet = Replace(rngWhere.Text, Chr(13) & Chr(7), "")
'get the previous cell until the last non-empty cell
Do Until Replace(oCell.Previous.Range.Text, Chr(13) & Chr(7), "") = ""
If oCell.Previous Is Nothing Then
Exit Do
Else
Set oCell = oCell.Previous
End If
Set rngWhere = oCell.Range
sRet = " - " & sRet
sRet = Replace(rngWhere.Text, Chr(13) & Chr(7), "") & sRet
Loop
End With
fGetTableTitle = sRet
End Function

[ceilidh]

By the way, the VBA code looks "spread out" in that last post of mine... not sure why. I copy/pasted it direct from Word. I hope it doesn't make it harder to read.

Edited to add: I never mentioned, but the "hangup" I had with my VBA window when running code is gone now. I ran a macro I knew worked, and it ran without the VBA window popping up. Then I ran BuildTOC again and the VBA window popped up. Then I did Debug and cleared all the breakpoints (that was an option under Debug) and tried running again - this time it ran without the VBA window popping open.

And i ran it again today, and it's still good. So it must have been a breakpoint I forgot about, just as you thought. Must remember that one for the future...

I meant to report on this, but in all the work over anonymizing those graphs (took me a good 2 hours this p.m.!) I forgot till now.

[Frosty]

It's a pain, but it's okay. Doesn't take long to adjust. We can blame the various browsers for that... I find it can be useful to copy/paste into notepad before pasting into the broswer, sometimes.

Bigger concern here is that it looks to me like the title info is in the graphic too. Is that a result of your work to anonymize the graphics, or is that representative of the document?

If the title info isn't actual text in the document, then we don't have a lot of options, although we have a few.

Is that definitely representative? If it is, then I'll list the options.

[Frosty]

Barring anything else... this is one way to approach the building of the TOC -- if the text is in the graphic, then we're not going to be able to find it out programmatically (without a lot of machinations which, to me, aren't worth it-- unless you want to start breaking apart the graphic into its constituent parts and attempt to locate the text that you want).

However, this might work for your purposes. This slightly updated code does the following:
1. Takes care of deleting an existing TOC section
2. Takes care of deleting any existing TOC entry fields in the given range (new function)
3. Selects the *inlineshape* in the range, and then prompts the user to fill in some text to put in the TOC Entry field.
4. Made an adjustment to your programming-- remember, if you're going to use a Doc variable (oDoc), then make sure to use it (you have ActiveDocument sprinkled in, even after setting oDoc = ActiveDocument).

What do you think?


Public Sub BuildTOC()
Dim oDoc As Document
Dim rngInsert As Range
Dim bTOCExists As Boolean
Set oDoc = ActiveDocument
'actually, first see if we already have a TOC section
With oDoc.Sections(1)
If InStr(.Headers(wdHeaderFooterPrimary).Range, "TABLE OF CONTENTS") > 0 Then
'we'll assume we have one, so let's delete it so we can refresh
'this takes care of the section
.Range.Delete
'and the section break
.Range.Characters.Last.Delete
End If
End With
'First, insert a TOC section at the beginning
oDoc.Sections.Add oDoc.Content
'Set the second section to not link to previous, and restart the page numbering
With oDoc.Sections(2).Headers(wdHeaderFooterPrimary)
.LinkToPrevious = False
.PageNumbers.RestartNumberingAtSection = True
.PageNumbers.StartingNumber = 1
End With
'Set up the first section
With oDoc.Sections(1)
'Clear out the header, substitute our own text
With .Headers(wdHeaderFooterPrimary).Range
.Text = "TABLE OF CONTENTS"
.Font.Size = 16
.Font.Bold = True
.ParagraphFormat.Alignment = wdAlignParagraphCenter
End With
End With
'Now we need to mark the TOC entries, call the subroutine for this
MarkForTOC oDoc
'Now create the table of contents...
Set rngInsert = oDoc.Sections(1).Range
rngInsert.Collapse wdCollapseStart
oDoc.TablesOfContents.Add Range:=rngInsert, _
RightAlignPageNumbers:=True, _
UseHeadingStyles:=False, _
UseFields:=True, _
TableID:="C", _
IncludePageNumbers:=True, _
AddedStyles:="", _
UseHyperlinks:=True, _
HidePageNumbersInWeb:=True, _
UseOutlineLevels:=False
'...and format it
oDoc.TablesOfContents(1).TabLeader = wdTabLeaderDots
oDoc.TablesOfContents.Format = wdIndexIndent
End Sub

Specific criteria to mark for our table of contents, and then put the field in the document

Public Sub MarkForTOC(oDoc As Document)
Dim oSec As Section
Dim rngWhere As Range
Dim oTable As Table
Dim sTableEntryText As String
Dim rngOrigSelection As Range
'since we might select something in here, we should store the original selection
Set rngOrigSelection = Selection.Range.Duplicate
For Each oSec In oDoc.Sections
'skip the first section, since that's our TOC
If oSec.Index = 1 Then
GoTo l_next
End If
'if the section doesn't have a table, we have some options
If oSec.Headers(wdHeaderFooterPrimary).Range.Tables.Count = 0 Then
'get the range
Set rngWhere = oSec.Range
DeleteTOCEntryFields rngWhere
rngWhere.Collapse wdCollapseStart
'Should we put in dummy text?
sTableEntryText = "Dummy Text"
'should we ask? (if so, we should select the graphic to help with the labelling)
If oSec.Range.InlineShapes.Count > 0 Then
oSec.Range.InlineShapes(1).Select
sTableEntryText = InputBox("Label this TOC entry", "Mark For TOC", sTableEntryText)
End If
rngWhere.Fields.Add rngWhere, wdFieldEmpty, "TC """ & sTableEntryText & """ ", False
'these are the typical sections... with a .Count greater than 0
Else
'get the table in the header, which contains our table title info - call the function for this
sTableEntryText = fGetTableTitle(oSec.Headers(wdHeaderFooterPrimary).Range.Tables(1))
'now that we have the table title, we need a place to insert it.
' using first blank line for now - revisit
'set and collapse the range
If oSec.Range.Tables.Count > 0 Then
Set oTable = oSec.Range.Tables(1)
Set rngWhere = oTable.Cell(1, 1).Range
'make sure to delete any TOC entry fields that already exist
DeleteTOCEntryFields rngWhere
rngWhere.Collapse wdCollapseStart
'insert the field
'rngWhere.Fields.Add rngWhere, wdFieldTOCEntry, sTableEntryText, False
'rngWhere.Fields.Add rngWhere, wdFieldEmpty, "TC ""Table - xxxxxxxxx"" ", False
rngWhere.Fields.Add rngWhere, wdFieldEmpty, "TC """ & sTableEntryText & """ ", False
End If
End If
l_next:
Next
'and restore our selection
rngOrigSelection.Select
End Sub

Delete any TOC Entry fields in the passed range

Public Sub DeleteTOCEntryFields(rngWhere As Range)
Dim i As Integer
' see if there are any fields, and if so...
If rngWhere.Fields.Count > 0 Then
'cycle through backwards, deleting any TOCEntry fields
For i = rngWhere.Fields.Count To 1 Step -1
If rngWhere.Fields(i).Type = wdFieldTOCEntry Then
rngWhere.Fields(i).Delete
End If
Next
End If
End Sub

Return the table title from the table

Public Function fGetTableTitle(oTable As Table) As String
Dim rngWhere As Range
Dim sRet As String
Dim oCell As Cell
Dim dRet As String
With oTable.Range
'start at the last cell, and move backwards until our first non-empty cell
Set oCell = .Cells(.Cells.Count)
Do Until Replace(oCell.Range.Text, Chr(13) & Chr(7), "") <> ""
If oCell.Previous Is Nothing Then
Exit Do
Else
Set oCell = oCell.Previous
End If
Loop
Set rngWhere = oCell.Range
'get the text of this cell, ignoring the special end of cell marker
sRet = Replace(rngWhere.Text, Chr(13) & Chr(7), "")
'get the previous cell until the last non-empty cell
Do Until Replace(oCell.Previous.Range.Text, Chr(13) & Chr(7), "") = ""
If oCell.Previous Is Nothing Then
Exit Do
Else
Set oCell = oCell.Previous
End If
Set rngWhere = oCell.Range
sRet = " - " & sRet
sRet = Replace(rngWhere.Text, Chr(13) & Chr(7), "") & sRet
Loop
End With
fGetTableTitle = sRet
End Function


EDIT: with these updates, you should be able to re-run the routine multiple times on the same document without problems (and, if you insert a later section or make edits to the document, it could rebuild the TOC for you without you having to go manually deleting a bunch of stuff)

[ceilidh]

It's a pain, but it's okay. Doesn't take long to adjust. We can blame the various browsers for that... I find it can be useful to copy/paste into notepad before pasting into the broswer, sometimes.

Bigger concern here is that it looks to me like the title info is in the graphic too. Is that a result of your work to anonymize the graphics, or is that representative of the document?

If the title info isn't actual text in the document, then we don't have a lot of options, although we have a few.

Is that definitely representative? If it is, then I'll list the options.

Yes, it's definitely representative. I'm sorry :(

It's the reason why it took me so long to anonymize the graphs too. Because the title text is in the picture object itself, just like the graphic is, the only way to anonymize it was to go back to the source and pull the original program out, then scramble up some data and run the original program with everything xxxx'd out. So you've had to wait... if the titles etc had been in a text box it would have been easy.

Just as well I'm a damn good programmer with the language I am familiar with :) even if I'm terrible with VB..... (SQL server and Asp.net mostly)

I'm going to read your longer post right now.

[Frosty]

No worries... I'm in no time crunch :)

And you're not terrible at VB, just unfamiliar. I think the skill of the programmer is independent of the familiarity of the language. The same basic concepts apply: structured/organized code is good. Unstructured/disorganized code is bad. But get it working first, and then attempt to get it working well. It's all the same.

I don't know anything about Asp.net -- if I need help some time, I'll know who to ask :)

[ceilidh]

Frosty, just read through your message and looked at the code. I've been studying the original code for so long now that the new code is sort of making sense to me even though this is my first read of it - maybe progress?!

In reply to your numbered points:

1. Takes care of deleting an existing TOC section

I never even thought of this, but good idea - it's possible I'd have to recreate the TOC and without this I'd have to recreate all the way from individual docs all the time.

2. Takes care of deleting any existing TOC entry fields in the given range (new function)

Is this the field codes that get tucked into the first cell of each table? Makes sense.

3. Selects the *inlineshape* in the range, and then prompts the user to fill in some text to put in the TOC Entry field.

Wow... great idea... I never even thought of getting the user to fill in text for the TOC entry into an input box. That would be a really good solution. It's not like there's dozens of graphs per document - maybe 5 at most - so this wouldn't be too intensive, typing a TOC title for each graph.

4. Made an adjustment to your programming-- remember, if you're going to use a Doc variable (oDoc), then make sure to use it (you have ActiveDocument sprinkled in, even after setting oDoc = ActiveDocument).

Sorry... I'll watch that. I'll get better!

Is the code ready to try out now? It does look good to me on first read. I really like that idea of an input box for entering the TOC text for the graphic. The text goes into the field code and the TOC, both, correct? I like this better than attempting to break the graphics page apart anyway.

[Frosty]

It worked on your sample document, so I'd say sure. You may want to change the "Dummy Text" prompt to something like "Insert Graph Title" or something, but other than that-- yeah, it's ready to go if you like the InputBox approach.

There are slicker ways to do this than an input box, but if it doesn't seem to onerous, I think you'll be good.

The only thing that seems breakable to me is that the .InlineShapes thing is a big guess. If all of your graphs are inline shapes, then you'll be fine. But if you ever move them around and get them converted to floating shapes, then you're going to have to address those scenarios (Floating shapes are part of the .ShapeRange collection, inline shapes are part of the .InlineShapes collection).

In answer to your #2 question: not just the first cell range... but any range you pass it. In the case of a section with a table, yes-- that's the range that gets passed. But on the graph sections, we're passing the entire range of the section. Subtle difference, but a difference.

But... as they say... bit by bit.

[Frosty]

Oh, and if there was any way for your graph-generating program to dump the title of the graph into the .Title property of the inline shape, then you could go away from the input box methodology... but apart from that, facilitating the manual process is all I can see as an option, based on your attachment.

[ceilidh]

Great... I'll give it a go and report back.

How do you tell the difference between an inline shape and a floating shape by looking at the graph? If you can. If they both look alike then if the code didn't work on a graph, I just assume I have a floating shape here and add that to the code...?

And that reminds me, can i do multiple Else statements for VB? Like this:

If.... Then
....
Else
.....
Else
.....


I can do multiple Else statements when I program, and often do, so it's occurred to me to wonder about that ability for VBA. So far I've only needed one Else statement for anything, though, so this is really a question for the future.

[Frosty]

You can do multiple Else statements, but the are...

If x = 1 Then
....
ElseIf x = 2 Then
....
ElseIf x > 4 Then
....
Else
.....
End If

Personally, I tend to use Select Case statements... but you are limited to a single logical statement unless you want to get really wacky with your structure.


Select Case x
Case 0
Case 1
Case 2
Case Else
End Select

To have a select case statement approximate the ElseIf structure of

If x = 1 Then
ElseIf y = 2 Then
End If

you have to do something I'm not a fan of (mostly because it just doesn't really make sense to me, so I don't find it readable)

Select Case True
Case x = 1
Case y = 2
Case Else
End Select

But those are the more complicated logic structures. My general rule is, if I'm in a logic structure that takes up more than vertical space immediately viewable in my code screen, I adjust my code.

I like to, wherever possible, see both the beginning and ending of my logic structures. That's a big part of my guidance on when to modularize a function.

[Frosty]

And in answer to telling the difference between an inline shape and a floating shape... the major difference is the WrapText property. Select the shape, right click, and then check to see what Wrap Text says. If it says Inline with text, then it's an inline shape. Otherwise, it's not.

This is actually a pretty complicated topic, and varies quite a bit between versions of Word. The concept doesn't change, but how you identify shapes (and the bugs) is quite a bit different.

You could deal with it by simply checking both the .ShapeRange.Count and the .InlineShapes.Count of the oSec.Range-- if that makes sense.

[ceilidh]

Frosty, sent a PM.