Hi Frosty and Fumei, back again with some progress. I've been wrestling with this and delayed replying till I had progress to report.
Frosty, the code you posted didn't work for me as it was, since the header text was a bit more complicated - page numbers for example which meant all the headers were "unique". And I wanted to ignore spacing. But I stuck with your concept of analyzing header text to turn on the linktoprevious. I have this working for me now. Here's the code for that. Works beautifully, and I show LinkToPrevious=True exactly where I should, and not where I shouldn't.
[VBA]Sub RSectionBrk_2()
Dim oDoc As Document
Dim oSec As Section
Dim hf As HeaderFooter
Dim hfCurr As String
Dim hfPrev As String
Set oDoc = ActiveDocument
For Each oSec In oDoc.Sections
'skip the first section
If oSec.Index = 1 Then
GoTo l_next
End If
For Each hf In oSec.Headers
If oSec.Headers(wdHeaderFooterPrimary).Range.Tables.Count > 0 Then
'get the table in the header, which contains table title info - call the function for this
hfCurr = fGetHeaderText(oSec.Headers(wdHeaderFooterPrimary).Range.Tables(1))
hfPrev = fGetHeaderText(oDoc.Sections(oSec.Index - 1).Headers(wdHeaderFooterPrimary).Range.Tables(1))
If hfCurr = hfPrev Then
hf.LinkToPrevious = True
End If
End If
Next
l_next:
Next
End Sub
Public Function fGetHeaderText(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 until the Page number
Do Until InStr(oCell.Previous.Range.Text, "Page") > 0
Set oCell = oCell.Previous
Set rngWhere = oCell.Range
sRet = " - " & sRet
sRet = Replace(rngWhere.Text, Chr(13) & Chr(7), "") & sRet
Loop
End With
fGetHeaderText = sRet
End Function
[/VBA]
So, after that, it was on to the next bit. Deleting the section breaks and inserting manual page breaks. I tried your code up above first, and I'm sorry to report that it didn't work for me either. For some reason, it deleted all my headers. And it deleted all the unneccessary section breaks but didn't put in a page break. I thought I would try coding it myself before coming back here, using your framework, which did work. (i.e. the conditional "if linktoprevious" bit was working, because the only section breaks getting deleted were the ones I wanted deleted. I just didn't want headers deleted, and I needed manual page breaks to replace the deleted section breaks.)
I am not all the way there yet. The code is working so far, in that it inserts a page break right before each section break that I want deleted. And only before those section breaks that I want deleted. And my headers are all preserved, too. But - I can't quite get to the end of it - I'm having trouble figuring out how to delete the section break after the page break has been inserted. Here's the code for the next bit. (It won't stay as a separate subroutine. When it works, I will include it in the Sub RSectionBrk_2 above. But while I am trying to get it to work, I coded it as it's own subroutine so I could focus on just that code.)
[VBA]Sub SectionPage()
Dim iSec As Integer
Dim oDoc As Document
Set oDoc = ActiveDocument
For iSec = oDoc.Sections.Count To 2 Step -1
If oDoc.Sections(iSec).Headers(wdHeaderFooterPrimary).LinkToPrevious = True Then
With oDoc.Sections(iSec).Range
.Collapse Direction:=wdCollapseStart
.InsertBreak Type:=wdPageBreak
End With
End If
Next iSec
End Sub [/VBA]
This has been a real learning experience for me! I thought it would be better for me to try and figure some of this out for myself rather than coming back and saying "it didn't work for me" without doing anything to contribute. So, you've had to wait. I apologize for that. Can you help me at all with the last bit? I've tried several code bits for deleting section breaks but so far nothing I do on that is working.
There was a question about RTF files. These aren't RTF, no. They are DOCX. My example document is DOC because I have an older copy of Word on my home PC than on my work PC, but the real documents are DOCX. I figured it wouldn't matter whether it was DOC or DOCX for this purpose. I am not very clear, admittedly, on the difference between RTF and DOC/DOCX. (I assume there must be a difference?) But certainly all the files I'm working with, with all this VBA coding, are DOCX, if that helps.
Reply With Quote