Как выбрать указанный c текст в ячейке для форматирования, когда таблица находится в заголовке

Question

Мне нужно удалить и заменить верхний и нижний колонтитулы около 50 документов, поэтому я пишу код VBA для изменения верхнего и нижнего колонтитула. В заголовке я хочу, чтобы lo go справа и текст в две строки были центрированы в заголовке. Текст в верхней строке должен быть отформатирован иначе, чем вторая строка.

Вот код, который у меня есть сейчас - я написал код только для первой строки; Я хотел, чтобы это работало, прежде чем добавлять код для форматирования второй строки. Когда он выполняется - (в режиме прерывания) Указанная строка фактически не выбрана - выделение остается только содержимым ячейки, и форматирование применяется ко всему тексту заголовка.

Private Sub AddHeaderToRange(rng As Word.Range)
    Dim imgPath As String, myImg As InlineShape, secondLine As String, firstLine As String
    firstLine = "Imagine Southwest Region"
    secondLine = "AZ Social Studies 2020-21"
    imgPath = "C:\Users\Laura.Defibaugh\Pictures\imagine_logo.jpg"


    With rng
        .Tables.Add Range:=rng, NumRows:=1, NumColumns:=2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitWindow
        With .Tables(1)
            .Borders.InsideLineStyle = wdLineStyleNone
            .Borders.OutsideLineStyle = wdLineStyleNone
            .Cell(1, 1).SetWidth ColumnWidth:=InchesToPoints(9), RulerStyle:=wdAdjustNone
            .Cell(1, 2).SetWidth ColumnWidth:=InchesToPoints(0.8), RulerStyle:=wdAdjustNone
            .Cell(1, 1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
            .Cell(1, 1).Range.Text = firstLine & vbCrLf & secondLine
            Set myImg = .Cell(1, 2).Range.InlineShapes.AddPicture("C:\Users\Laura.Defibaugh\Pictures\imagine_logo.jpg")
                With myImg
                    .Width = InchesToPoints(0.8)
                    .Height = InchesToPoints(0.8)
            End With

            .Cell(1, 1).Range.Select

                With Selection.Find
                    .Forward = True
                    .Wrap = wdFindStop
                    .Text = firstLine
                    .Execute
                End With

                With Selection.Font
                    .Bold = True
                    .Size = 20
                End With
        End With
    End With

End Sub

Answer 1

Просто создайте новый документ с требуемым макетом верхнего / нижнего колонтитула, а затем используйте метод FormattedText, чтобы скопировать его во все целевые документы. Например:

Sub UpdateDocumentHeadersAndFooters()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String
Dim wdDocTgt As Document, wdDocSrc As Document
Dim Sctn As Section, HdFt As HeaderFooter
strFolder = GetFolder
If strFolder = "" Then Exit Sub
Set wdDocSrc = ActiveDocument
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
    If strFolder & "\" & strFile <> wdDocSrc.FullName Then
        Set wdDocTgt = Documents.Open(FileName:=strFolder & "\" & strFile, _
        AddToRecentFiles:=False, Visible:=False)
        With wdDocTgt
            For Each Sctn In .Sections
                'For Headers
                For Each HdFt In Sctn.Headers
                    With HdFt
                        If .Exists Then
                            If .LinkToPrevious = False Then
                                .Range.FormattedText = _
                                wdDocSrc.Sections.First.Headers(wdHeaderFooterPrimary).Range.FormattedText
                            End If
                        End If
                    End With
                Next
                'For footers
                For Each HdFt In Sctn.Footers
                    With HdFt
                        If .Exists Then
                            If .LinkToPrevious = False Then
                                .Range.FormattedText = _
                                wdDocSrc.Sections.First.Footers(wdHeaderFooterPrimary).Range.FormattedText
                            End If
                        End If
                    End With
                Next
            Next
            .Close SaveChanges:=True
        End With
    End If
    strFile = Dir()
Wend
Set wdDocSrc = Nothing: Set wdDocTgt = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

В кодированном виде макрос предполагает, что документ, из которого вы запускаете макрос, имеет только один раздел, содержащий до трех заполненных верхних и нижних колонтитулов (как разрешено Word), и что все Заголовки в целевом документе должны быть обновлены в соответствии с первичным верхним и нижним колонтитулами исходного документа.

Если вы хотите обновить только первый раздел, измените «Для каждого Sctn в .Sections» на «Задать Sctn =. Sections.First 'и удалите соответствующее' Next '.