Удалить последний абзац в заголовке с помощью vba

Question

Я хочу удалить последнюю строку в заголовке.В настоящее время у меня есть 2 строки в заголовке: первую, которую я копирую и вставляю, а вторую, которая была там до копирования и вставки (начальная точка для копирования и вставки).

Я пробовал что-то подобное:

`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)`

Ожидается, что будет только одна строка, которую я копирую и вставляю из другого документа. Только одна строка, чтобы получить немного места с заголовком.

Хорошо, вот одначтобы лучше понять мой вопрос:

Надеюсь, что поможет!

Answer 1

Предполагается, что документ с заголовком, который вы хотите скопировать, активен, а макрос находится в этом документе:

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

Answer 2

Я не уверен, что хорошо понимаю, что вы имеете в виду, но я думаю, что вы ищете следующее: Попробуйте это

`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)


`