calacuccia
asked on
Dynamic footer depending on entry in main document
I'm trying to get a quote templace to show the quote number in the footer.
Most viable way seemed to use a textbox, in the text bpdy and use the textbox/change event to trigger the VBA to rewrite the footer accordingly.
It works perfectly except for one nast detail: when the used taps 2-3 character quickly, the textbox gets deleted. Odd, but it happens on both tested computers.
Looking for a fix or alternate solutions than a text box.
Attached a sample document.
The code is below:
rivate Sub TextBox1_Change()
Dim oRge As Range
ActiveDocument.Sections.It em(ActiveD ocument.Se ctions.Cou nt).Footer s(wdHeader FooterPrim ary).Range .Text = ""
Set oRge = EndOfLastFooter()
oRge.Text = "Page "
oRge.Collapse wdCollapseEnd
oRge.Fields.Add Range:=oRge, Type:=wdFieldPage
Set oRge = EndOfLastFooter()
oRge.Text = " of "
Set oRge = EndOfLastFooter()
oRge.Collapse wdCollapseEnd
oRge.Fields.Add Range:=oRge, Type:=wdFieldNumPages
Set oRge = EndOfLastFooter()
oRge.Text = vbTab & TextBox1.Value
Set oRge = EndOfLastFooter()
oRge.Collapse wdCollapseEnd
oRge.Text = vbTab & " SP/01/03/175/I"
With ActiveDocument.Sections
Set oRge = .Item(.Count).Footers(wdHe aderFooter Primary).R ange
End With
oRge.Fields.Update
Set oRge = Nothing
End Sub
Private Function EndOfLastFooter() As Range
Dim oRg As Range
With ActiveDocument.Sections
Set oRg = .Item(.Count).Footers(wdHe aderFooter Primary).R ange
End With
oRg.Collapse wdCollapseEnd
Set EndOfLastFooter = oRg
Set oRg = Nothing
End Function
test.doc
Most viable way seemed to use a textbox, in the text bpdy and use the textbox/change event to trigger the VBA to rewrite the footer accordingly.
It works perfectly except for one nast detail: when the used taps 2-3 character quickly, the textbox gets deleted. Odd, but it happens on both tested computers.
Looking for a fix or alternate solutions than a text box.
Attached a sample document.
The code is below:
rivate Sub TextBox1_Change()
Dim oRge As Range
ActiveDocument.Sections.It
Set oRge = EndOfLastFooter()
oRge.Text = "Page "
oRge.Collapse wdCollapseEnd
oRge.Fields.Add Range:=oRge, Type:=wdFieldPage
Set oRge = EndOfLastFooter()
oRge.Text = " of "
Set oRge = EndOfLastFooter()
oRge.Collapse wdCollapseEnd
oRge.Fields.Add Range:=oRge, Type:=wdFieldNumPages
Set oRge = EndOfLastFooter()
oRge.Text = vbTab & TextBox1.Value
Set oRge = EndOfLastFooter()
oRge.Collapse wdCollapseEnd
oRge.Text = vbTab & " SP/01/03/175/I"
With ActiveDocument.Sections
Set oRge = .Item(.Count).Footers(wdHe
End With
oRge.Fields.Update
Set oRge = Nothing
End Sub
Private Function EndOfLastFooter() As Range
Dim oRg As Range
With ActiveDocument.Sections
Set oRg = .Item(.Count).Footers(wdHe
End With
oRg.Collapse wdCollapseEnd
Set EndOfLastFooter = oRg
Set oRg = Nothing
End Function
test.doc
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
One last try to bring this to somebody's attention (also known as bump)
ASKER
I certainly find this behaviour very unexpected, for a control to disappear like that. Once again, I loose Word confidence :-)
Formfields is no option: this document is basically edittable from Start to End for some exception, it would become a burden if formfiels had to be used all over this document.
I hope I can prevent to have to use a UserForm, but that would probably work.
Why do you mention the Last method? I did not see where this could help.