Remove last paragraph mark on header with vba

0
votes

I want to remove the last line on the header. I currently have 2 lines in the header: the first one I copy-paste and the second one which was there before the copy-paste (the starting point for the copy-paste).

I tried something like that:

`Selection.Sections(1).Headers(1).Range.MoveEnd Unit:=wdCharacter, Count:=-1`

`Documents.Open (strFilename)
Selection.Sections(1).Headers(1).Range.Copy
ThisDocument.Activate
Selection.Sections(1).Headers(1).Range.Paste
Documents(strFilename).Close (0)`

Expect to have only one line, the one I copy-paste from another document Only one line to gain a bit of space with the header.

OK, here is one picture to understand better my question:

Header with or without extra paragraph mark Hope that help!

2
vbams-wordheader
The question isn't clear...Maybe if you make screen shots of what you want and what you're actually getting? Remember you can use the edit link below the question to add/change information. - Cindy Meister
I edit my question with a picture, but macropod understood my question and everything is working as I wanted. Thanks for your help. - JLuc01

2 Answers

0
votes

Assuming the document with the header you want to replicate is active and the macro is in that document:

Sub Demo()
Application.ScreenUpdating = False
Dim DocSrc As Document, DocTgt As Document
Set DocSrc = ActiveDocument
Set DocTgt = ActiveWindow.Next.Document
With DocTgt.Sections(1).Headers(1).Range
  .FormattedText = DocSrc.Sections(1).Headers(1).Range.FormattedText
  .Characters.Last.Previous = vbNullString
End With
Application.ScreenUpdating = True
End Sub
0
votes

I am not sure that I understand well what you mean, but I think that what you are looking for is the following, Try it

`Selection.Sections(1).Headers(1).Range.MoveEnd Unit:=wdCharacter, Count:=-1`

`Documents.Open (strFilename)
    Dim strText() As String
    Dim MyCell As String

    ThisDocument.Activate
    MyCell = Selection.Sections(1).Headers(1).Range.Text
    strText = Split(MyCell , vbCrLf)
    Selection.Sections(1).Headers(1).Range.Text=strText(0)
    Documents(strFilename).Close (0)


`