#1
|
||||
|
||||
Saving information into Footer doesn't close footer
I have the following VBA code that ends with the screen in draft mode and the edit footer dialog box open. I have to click the red X to close the footer edit and then change to print view. What am I missing? VBA should beable to do it all? Point me in the right direction. Otherwise the code does what it should. Code:
Sub DateFooter() ' get first day of the month MyDate = DateSerial(Year(Date), Month(Date), 1) ' what day of the week is it - 1 = sun 2= mon ... Fri = 6 w1 = Weekday(MyDate) ' set second firday of the month w = 6 - w1 + 7 + 1 MyDate2 = DateSerial(Year(Date), Month(Date), w) My3 = Format(MyDate2, "dddd, mmmm dd yyyy") ' this doesn't work current page number is always 1 ' For i = 1 To ActiveDocument.Sections.Count ' With ActiveDocument.Sections(i) ' .Footers(wdHeaderFooterPrimary).Range.Text = My3 & String(175, " ") & "Page " & Selection.Information(wdActiveEndPageNumber) & " of " & Selection.Information(wdNumberOfPagesInDocument) ' End With ' thit works but when I get back to the document I need to close the footer and ' I am still left in draft mode ActiveDocument.Sections(ActiveDocument.Sections.Count) _ .Footers(wdHeaderFooterPrimary).Range.Select With Selection ' .Paragraphs(1).Alignment = wdAlignParagraphCenter .TypeText Text:=My3 & String(175, " ") & "Page " .Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _ "PAGE ", PreserveFormatting:=True .TypeText Text:=" of " .Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _ "NUMPAGES ", PreserveFormatting:=True End With If ActiveWindow.View.SplitSpecial = wdPaneNone Then ActiveWindow.ActivePane.View.Type = wdPrintView Else ActiveWindow.View.Type = wdPrintView End If End Sub Last edited by macropod; 07-12-2018 at 08:45 PM. Reason: Added code tags |
#2
|
||||
|
||||
Use ranges and you don't have to open the footer, so no need then to close it. Also get into the habit of declaring your variables e.g.
Code:
Sub DateFooter() Dim oRng As Range Dim myDate As Long, myDate2 As Long Dim w As Long, w1 As Long Dim my3 As String Dim oSection As Section Dim oFooter As HeaderFooter ' get first day of the month myDate = DateSerial(Year(Date), Month(Date), 1) ' what day of the week is it - 1 = sun 2= mon ... Fri = 6 w1 = Weekday(myDate) ' set second firday of the month w = 6 - w1 + 7 + 1 myDate2 = DateSerial(Year(Date), Month(Date), w) my3 = Format(myDate2, "dddd, mmmm dd yyyy") ' this doesn't work current page number is always 1 ' For i = 1 To ActiveDocument.Sections.Count ' With ActiveDocument.Sections(i) ' .Footers(wdHeaderFooterPrimary).Range.Text = My3 & String(175, " ") & "Page " & Selection.Information(wdActiveEndPageNumber) & " of " & Selection.Information(wdNumberOfPagesInDocument) ' End With ' thit works but when I get back to the document I need to close the footer and ' I am still left in draft mode For Each oSection In ActiveDocument.Sections For Each oFooter In oSection.Footers If oFooter.Exists Then Set oRng = oFooter.Range With oRng .Text = my3 & Chr(175) & Chr(32) & "Page " .Collapse 0 ActiveDocument.Fields.Add oRng, wdFieldPage, , False End With Set oRng = oFooter.Range With oRng .Collapse 0 .Text = " of " .Collapse 0 ActiveDocument.Fields.Add oRng, wdFieldNumPages, , False End With End If Next oFooter Next oSection Set oSection = Nothing Set oFooter = Nothing Set oRng = Nothing End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
||||
|
||||
Thanks works great!
Bad habit not declaring variables, But I do try and put in comments. |
Tags |
footer, setting |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
I have 20 page word document with a footer. Can i change page # 10 footer only? | aligahk06 | Word | 2 | 10-25-2017 04:53 AM |
Footer doesn't print on first page | Briank | Mail Merge | 2 | 06-15-2016 06:28 PM |
Header and footer aligned in the footer area | ashiqghfr | Word | 2 | 07-23-2015 01:14 AM |
Footer - more then one footer (auto fill text in slides) | noodle | PowerPoint | 0 | 03-31-2013 04:50 AM |
header/footer not saving to gallery (word 2007) | lloydc | Word | 0 | 04-30-2012 05:29 PM |