Results 1 to 6 of 6
  1. #1
    New Lounger
    Join Date
    Jun 2012
    Posts
    11
    Thanks
    2
    Thanked 0 Times in 0 Posts

    Help with a footer macro

    Hi Guys,

    I am fixing a friends macro which when they open the template it has a dialog box which allows them to enter the title of their report and chapter name

    At the moment the macro puts the title and chapter on the left hand side of the footer but i actually want to insert it into a table in the footer where i have 3 columns and want the macro to put the title and chapter into the middle column

    i have the code i am currently playing with but cant figure out where to change it so i can do what my friend wants

    Any help would be great

    Code:
    Private Sub cmdok_Click()
    start:
            'check is chapternumber details have been filled in
            If Me.tbchapternumber.Value = "" Then
                GoTo start
            Else
                Unload Me
                    'check if chapter name field has been filled in
                    If Me.tbchaptername <> "" Then
                        'Enter chapter details
                        'Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst, Count:=3, Name:=""
                        Selection.GoTo What:=wdGoToBookmark, Name:="Begin"
        With ActiveDocument.Bookmarks
            .DefaultSorting = wdSortByName
            .ShowHidden = False
        End With
        If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
            ActiveWindow.Panes(2).Close
        End If
        If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
            ActivePane.View.Type = wdOutlineView Then
            ActiveWindow.ActivePane.View.Type = wdPrintView
        End If
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
        If Selection.HeaderFooter.IsHeader = True Then
            ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
        Else
            ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
        End If
        ActiveWindow.ActivePane.View.PreviousHeaderFooter
        ActiveWindow.ActivePane.View.PreviousHeaderFooter
        Selection.MoveDown Unit:=wdLine, Count:=1
        Selection.EndKey Unit:=wdLine
        Selection.MoveRight Unit:=wdCharacter, Count:=1
        Selection.EndKey Unit:=wdLine
        Selection.MoveRight Unit:=wdCharacter, Count:=1
        Selection.TypeText Text:=Me.tbreporttitle
        Selection.MoveRight Unit:=wdCharacter, Count:=1
        Selection.TypeText Text:="Contents"
        ActiveWindow.ActivePane.View.NextHeaderFooter
        Selection.MoveRight Unit:=wdCharacter, Count:=1
        Selection.MoveDown Unit:=wdLine, Count:=1
        Selection.MoveLeft Unit:=wdCharacter, Count:=1
        Selection.TypeText Text:=Me.tbreporttitle
        Selection.MoveRight Unit:=wdCharacter, Count:=1
        Selection.TypeText Text:="Contents"
        
        ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
                        
                        
                        
                        
                        Selection.GoTo What:=wdGoToBookmark, Name:="Begin"
                            With ActiveDocument.Bookmarks
                                .DefaultSorting = wdSortByName
                                .ShowHidden = False
                            End With
                        Selection.Style = ActiveDocument.Styles("Heading 1")
                        'WordBasic.EditAutoText Name:="VerticalLine", Insert:=1
                        Selection.TypeText Text:=vbTab
                        Selection.TypeText Text:=Me.tbchaptername
                        Selection.TypeParagraph
                            'insert bookmark begin
                            With ActiveDocument.Bookmarks
                                .Add Range:=Selection.Range, Name:="Begin"
                                .DefaultSorting = wdSortByName
                                .ShowHidden = False
                            End With
                            'view header/footer
                            If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
                                ActiveWindow.Panes(2).Close
                            End If
                            If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
                            ActivePane.View.Type = wdOutlineView Then
                                ActiveWindow.ActivePane.View.Type = wdPrintView
                            End If
                        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
                            If Selection.HeaderFooter.IsHeader = True Then
                                ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
                            Else
                                ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
                            End If
                        'change and enter footer details
                        Selection.MoveRight Unit:=wdCharacter, Count:=1
                        Selection.MoveDown Unit:=wdLine, Count:=1
                        Selection.TypeText Text:=Me.tbchapternumber
                        Selection.TypeText Text:=" "
                        Selection.TypeText Text:=Me.tbchaptername
                        Selection.HomeKey Unit:=wdLine
                        Selection.MoveLeft Unit:=wdCharacter, Count:=1
                        Selection.TypeText Text:=Me.tbreporttitle
                        'ActiveWindow.ActivePane.View.NextHeaderFooter
                        Selection.MoveRight Unit:=wdCharacter, Count:=1
                        Selection.MoveDown Unit:=wdLine, Count:=1
                        Selection.MoveLeft Unit:=wdCharacter, Count:=1
                        Selection.TypeText Text:=Me.tbreporttitle
                        Selection.MoveRight Unit:=wdCharacter, Count:=1
                        Selection.TypeText Text:=Me.tbchapternumber
                        Selection.TypeText Text:=" "
                        Selection.TypeText Text:=Me.tbchaptername
                        ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
                        Selection.GoTo What:=wdGoToBookmark, Name:="Begin"
                    Else
                        'message for not entering chapter name
                        MsgBox "Please enter a heading and try again."
                        GoTo start
                    End If
            End If
    End Sub

  2. #2
    Silver Lounger Charles Kenyon's Avatar
    Join Date
    Jan 2001
    Location
    Sun Prairie, Wisconsin, Wisconsin, USA
    Posts
    2,048
    Thanks
    124
    Thanked 119 Times in 116 Posts
    Uhm, macros dealing with headers and footers are a royal pain because each section in a document can have up to three different headers and three different footers.

    Why not put the information into a document property and have a DocProperty field in your header / footer in the template. You can have your macro update these fields upon closing your userform.

    Chapter name should be in the footer using a StyleRef field referring to a Heading style in the body of the document. That way when you add a new Chapter, your footer changes automatically.
    Charles Kyle Kenyon
    Madison, Wisconsin

  3. #3
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,054
    Thanks
    2
    Thanked 417 Times in 346 Posts
    Further to what Charles says, it is really difficult to understand what your code is supposed to be doing without seeing the document concerned. At a guess, I suspect it's something like:
    Code:
    Private Sub cmdok_Click()
    Dim HdFt As HeaderFooter
    start:
    'check is chapternumber details have been filled in
    If Me.tbchapternumber.Value = "" Then
      GoTo start
    Else
      Unload Me
      'check if chapter name field has been filled in
      If Me.tbchaptername <> "" Then
        'Enter chapter details
        Selection.GoTo What:=wdGoToBookmark, Name:="Begin"
        With Selection.Sections.First
          For Each HdFt In .Footers
            If HdFt.Range.Tables.Count > 0 Then
              With HdFt.Range.Tables(1)
                .Cell(1, 1).Range.Text = Me.tbreporttitle
                .Cell(2, 1).Range.Text = "Contents"
                .Cell(2, 1).Range.Text = Me.tbchapternumber
                .Cell(2, 2).Range.Text = Me.tbchaptername
              End With
            End If
          Next
        End With
        With Selection
          .Style = "Heading 1"
          .Text = vbTab & Me.tbchaptername & vbCr
          ActiveDocument.Bookmarks.Add Range:=.Range, Name:="Begin"
        End With
      Else
        'message for not entering chapter name
        MsgBox "Please enter a heading and try again."
        GoTo start
      End If
    End If
    End Sub
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  4. The Following User Says Thank You to macropod For This Useful Post:

    silentbob (2012-06-27)

  5. #4
    New Lounger
    Join Date
    Jun 2012
    Posts
    11
    Thanks
    2
    Thanked 0 Times in 0 Posts
    Thanks Paul and Charles for your help, I was just wondering if i could ask for some more. I adjusted your code to the following

    Code:
    Private Sub cmdok_Click()
    Dim HdFt As HeaderFooter
    start:
    'check is chapternumber details have been filled in
    If Me.tbchapternumber.Value = "" Then
      GoTo start
    Else
      Unload Me
      'check if chapter name field has been filled in
      If Me.tbchaptername <> "" Then
        'Enter chapter details
        Selection.GoTo What:=wdGoToBookmark, Name:="Begin"
        With Selection.Sections.First
          For Each HdFt In .Footers
            If HdFt.Range.Tables.Count > 0 Then
              With HdFt.Range.Tables(1)
                .Cell(1, 1).Range.Text = "Project NAME"
                .Cell(1, 2).Range.Text = Me.tbreporttitle
                .Cell(2, 2).Range.Text = Me.tbchapternumber
                .Cell(2, 3).Range.Text = Me.tbchaptername
              End With
            End If
          Next
        End With
      Else
        'message for not entering chapter name
        MsgBox "Please enter a heading and try again."
        GoTo start
      End If
    End If
    End Sub
    I was wondering if it was possible to create another macro which allowed the adding of a new chapter and hence a change the footer to add the new chapter heading without changing the previous chapter's footer?

    I am trying to adjust the above code as follows

    Code:
    Private Sub cmdok_Click()
    
    Dim HdFt As HeaderFooter
    start:
    'Check if chapter number field is filled in
            If Me.tbchapternumber.Value = "" Then
                MsgBox "Please enter a chapter number and try again."
                GoTo start
            Else
                Unload Me
                    'check if chapter name field is filled in
                    If Me.tbchaptername <> "" Then
                            'insert page break before inserting a chapter
                            If Me.cbpagebreak.Value = True Then
                                Selection.InsertBreak Type:=wdSectionBreakNextPage
            Selection.HeaderFooter.LinkToPrevious = Not Selection.HeaderFooter.LinkToPrevious
          
          With Selection.Sections.First
          For Each HdFt In .Footers
            If HdFt.Range.Tables.Count > 0 Then
              With HdFt.Range.Tables(1)
                .Cell(1, 1).Range.Text = "Project NAME"
                .Cell(2, 2).Range.Text = Me.tbchapternumber
                .Cell(2, 3).Range.Text = Me.tbchaptername
            End With
            End If
          Next
        End With
      Else
        'message for not entering chapter name
        MsgBox "Please enter a heading and try again."
        GoTo start
      End If
    End If
    End If
    
    End Sub

  6. #5
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,054
    Thanks
    2
    Thanked 417 Times in 346 Posts
    All you need to change with the previous code is:
    Code:
          For Each HdFt In .Footers
            If HdFt.Range.Tables.Count > 0 Then
    to:
    Code:
          For Each HdFt In .Footers
            HdFt.LinkToPrevious = False
            If HdFt.Range.Tables.Count > 0 Then
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  7. The Following User Says Thank You to macropod For This Useful Post:

    silentbob (2012-06-27)

  8. #6
    New Lounger
    Join Date
    Jun 2012
    Posts
    11
    Thanks
    2
    Thanked 0 Times in 0 Posts
    Thanks so much, worked a treat

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •