none
macro to add text to footer RRS feed

Answers

  • You've got multiple issues here.

    1. Screen updating is off but I don't see where you turn it back on.  This will cause you problems later.
    2. You're using a Selection method to add a textbox, however after entering the footer view you don't establish an insertion point in the footer.  Further, the selection position that you have defined is relative to the top and left of the page.  This is a problem because I assume you want to add the text box into the footer area at the bottom of the page.

    Take a look at this code and see if you can modify it to work with what you are trying to do in the footer.

    Sub footerTextBox()
        Dim rng As Word.Range
        Dim shp As Word.Shape
        Dim doc As Word.Document
        Dim top As Single
        Dim lft As Single
        
        Set doc = Word.ActiveDocument
        Set rng = doc.Sections(1).Footers(wdHeaderFooterPrimary).Range
        top = rng.Information(wdVerticalPositionRelativeToPage)
        lft = rng.Information(wdHorizontalPositionRelativeToPage)
        
        Set shp = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, lft, top, 100, 15, rng)
        shp.WrapFormat.Type = wdWrapInline
    End Sub


    Kind Regards, Rich ... http://greatcirclelearning.com

    • Marked as answer by hila_d Thursday, March 1, 2012 4:44 PM
    Thursday, March 1, 2012 2:14 PM
  • Right after the Set doc = Word.ActiveDocuement command add this line:

        doc.Sections(1).PageSetup.DifferentFirstPageHeaderFooter = True


    Kind Regards, Rich ... http://greatcirclelearning.com

    • Marked as answer by hila_d Sunday, March 4, 2012 12:48 PM
    Sunday, March 4, 2012 12:37 PM

All replies

  • Here is a general macro that checks all headers and footers in a document.

    Sub CheckHeadersAndFooters()
        Dim doc As Word.Document
        Dim rng As Word.Range
        Dim sec As Word.Section
        Dim hfRng As Word.HeaderFooter
        
        Set doc = Word.ActiveDocument
        
        For Each sec In doc.Sections
            For Each hfRng In sec.Headers
                Set rng = hfRng.Range
                'now do something with the data in this range
            Next hfRng
            For Each hfRng In sec.Footers
                Set rng = hfRng.Range
                'now do something with the data in this range
            Next hfRng
        Next sec
    End Sub

    By using a command such as this, you can work with just the primary footer.

            rng = sec.Footers(wdHeaderFooterPrimary).Range

    I hope this helps


    Kind Regards, Rich ... http://greatcirclelearning.com

    Thursday, March 1, 2012 11:39 AM
  • It might also be useful to test the LinkToPrevious state, so that unnecessay updates can be avoided:

    Sub CheckHeadersAndFooters()
    Dim Doc As Word.Document
    Dim Rng As Word.Range
    Dim Sec As Word.Section
    Dim HdFt As Word.HeaderFooter
    Set Doc = Word.ActiveDocument
    For Each Sec In Doc.Sections
      For Each HdFt In Sec.Headers
        If HdFt.LinkToPrevious = False Then
          Set Rng = HdFt.Range
          'now do something with the data in this range
        End If
      Next hfRng
      For Each hfRng In Sec.Footers
        If hfRng.LinkToPrevious = False Then
          Set Rng = hfRng.Range
          'now do something with the data in this range
        End If
      Next hfRng
    Next Sec
    End Sub


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Thursday, March 1, 2012 12:04 PM
  • Excellent point!! Thanks Paul

    Kind Regards, Rich ... http://greatcirclelearning.com

    Thursday, March 1, 2012 12:44 PM
  • Can I do it not with loop?

    to write in header I wrote:

     With ActiveDocument.ActiveWindow.View
            .Type = wdPrintView
            .SeekView = wdSeekPrimaryHeader
     End With

    Set text..

    How am I go to footer?

    Thursday, March 1, 2012 1:08 PM
  • You don't need a loop.  Change your seekview to:

    .SeekView = wdSeekPrimaryFooter


    Kind Regards, Rich ... http://greatcirclelearning.com

    Thursday, March 1, 2012 1:21 PM
  • It still set my text in headr. why it?

       With ActiveDocument.ActiveWindow.View
            .Type = wdPrintView
            .SeekView = wdSeekPrimaryFooter
        End With

    Thursday, March 1, 2012 1:28 PM
  • Post the code that shows what you are trying to do.

    Kind Regards, Rich ... http://greatcirclelearning.com

    Thursday, March 1, 2012 1:38 PM
  • Sub Warning_ClickHandler(control As IRibbonControl)
    
    
       Dim shpTbWarning As Shape
       Dim rngSelection As Range
            
        Application.ScreenUpdating = False
        
    On Error Resume Next
    
        With ActiveDocument.ActiveWindow.View
            .Type = wdPrintView
            .SeekView = wdSeekPrimaryFooter
        End With
        
        If (flagWarning = True) Then
           GoTo warningExist
        End If
    
        Set shpTbWarning = Selection.HeaderFooter.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
                                                                    Left:=10, _
                                                                    Top:=10, _
                                                                    Width:=20, _
                                                                    Height:=20)
    
    
        With shpTbWarning
            .Name = "textBoxWarning"
            .Line.ForeColor = vbBlue
            With .TextFrame
                .TextRange.ParagraphFormat.Alignment = wdAlignParagraphCenter
                .TextRange.ParagraphFormat.ReadingOrder = wdReadingOrderRtl
            End With
            With .TextFrame.TextRange.Font
                .Name = "Narkisim"
                .Size = 9
                .NameBi = "Narkisim"
                .SizeBi = 9
                .Color = wdColorBlue
            End With
        End With
                                                                  
        'Set reference to TextBox Range
       Set rngSelection = shpTbWarning.TextFrame.TextRange
         
        'Insert Text and Fields
        With rngSelection
            .InsertAfter "first line"
            .InsertParagraphAfter
            .InsertAfter "second line"
            .MoveEnd Unit:=wdCharacter, Count:=rngSelection.Characters.Count + 3
        End With
         
        ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
        flagWarning = True
           
    warningExist:
        '
    
    End Sub

    Thursday, March 1, 2012 1:42 PM
  • You've got multiple issues here.

    1. Screen updating is off but I don't see where you turn it back on.  This will cause you problems later.
    2. You're using a Selection method to add a textbox, however after entering the footer view you don't establish an insertion point in the footer.  Further, the selection position that you have defined is relative to the top and left of the page.  This is a problem because I assume you want to add the text box into the footer area at the bottom of the page.

    Take a look at this code and see if you can modify it to work with what you are trying to do in the footer.

    Sub footerTextBox()
        Dim rng As Word.Range
        Dim shp As Word.Shape
        Dim doc As Word.Document
        Dim top As Single
        Dim lft As Single
        
        Set doc = Word.ActiveDocument
        Set rng = doc.Sections(1).Footers(wdHeaderFooterPrimary).Range
        top = rng.Information(wdVerticalPositionRelativeToPage)
        lft = rng.Information(wdHorizontalPositionRelativeToPage)
        
        Set shp = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, lft, top, 100, 15, rng)
        shp.WrapFormat.Type = wdWrapInline
    End Sub


    Kind Regards, Rich ... http://greatcirclelearning.com

    • Marked as answer by hila_d Thursday, March 1, 2012 4:44 PM
    Thursday, March 1, 2012 2:14 PM
  • thank you.

    Can you display me- what the different?

    Thursday, March 1, 2012 4:45 PM
  • I'm not sure I understand your question.  We might have a translation problem. :-)  However, maybe you are asking what your altered code might look like.  I've left in your variable names, commented out the changes and altered the Sub routine start line so that I could test via VBA.  Try it and hopefully it's placing the text box where you want it.

    Sub Warning_ClickHandler()
    'Sub Warning_ClickHandler(control As IRibbonControl)
        Dim shpTbWarning As Shape
        Dim rngSelection As Range
        Dim doc As Word.Document
        Dim top As Single
        Dim lft As Single
        Dim flagWarning As Boolean
        
        Set doc = Word.ActiveDocument
        Set rngSelection = doc.Sections(1).Footers(wdHeaderFooterPrimary).Range
        top = rngSelection.Information(wdVerticalPositionRelativeToPage)
        lft = rngSelection.Information(wdHorizontalPositionRelativeToPage)
        
        Set shpTbWarning = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, lft, top, 20, 20, rngSelection)
        shpTbWarning.WrapFormat.Type = wdWrapInline
            
    '    Application.ScreenUpdating = False
        
    'On Error Resume Next
    '
    '    With ActiveDocument.ActiveWindow.View
    '        .Type = wdPrintView
    '        .SeekView = wdSeekPrimaryFooter
    '    End With
    '
    '    If (flagWarning = True) Then
    '       GoTo warningExist
    '    End If
    '    Set shpTbWarning = Selection.HeaderFooter.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
    '                                                                Left:=10, _
    '                                                                top:=10, _
    '                                                                Width:=20, _
    '                                                                Height:=20)
        With shpTbWarning
            .Name = "textBoxWarning"
            .line.ForeColor = vbBlue
            With .TextFrame
                .TextRange.ParagraphFormat.Alignment = wdAlignParagraphCenter
                .TextRange.ParagraphFormat.ReadingOrder = wdReadingOrderRtl
            End With
            With .TextFrame.TextRange.Font
                .Name = "Narkisim"
                .Size = 9
                .NameBi = "Narkisim"
                .SizeBi = 9
                .Color = wdColorBlue
            End With
        End With
                                                                  
        'Set reference to TextBox Range
       Set rngSelection = shpTbWarning.TextFrame.TextRange
         
        'Insert Text and Fields
        With rngSelection
            .InsertAfter "first line"
            .InsertParagraphAfter
            .InsertAfter "second line"
            .MoveEnd Unit:=wdCharacter, count:=rngSelection.Characters.count + 3
        End With
         
        ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
        flagWarning = True
           
    warningExist:
        '
    End Sub


    Kind Regards, Rich ... http://greatcirclelearning.com

    Thursday, March 1, 2012 5:11 PM
  • it work. thank you.

    if I want to delete shpTbWarning (my textbox in footer) how am I do this?

    if I want delete it only from first page?

    Sunday, March 4, 2012 9:01 AM
  • Right after the Set doc = Word.ActiveDocuement command add this line:

        doc.Sections(1).PageSetup.DifferentFirstPageHeaderFooter = True


    Kind Regards, Rich ... http://greatcirclelearning.com

    • Marked as answer by hila_d Sunday, March 4, 2012 12:48 PM
    Sunday, March 4, 2012 12:37 PM