时间戳

首页 > 解决方案 > 当表格位于标题中时，如何选择单元格中的特定文本进行格式化

vba - 当表格位于标题中时，如何选择单元格中的特定文本进行格式化

问题描述

我必须删除和替换大约 50 个文档的页眉和页脚，所以我正在编写 VBA 代码来更改页眉和页脚。在标题中，我想要右侧的徽标，以及位于标题中心的两行文本。第一行文本的格式应与第二行不同。

这是我现在拥有的代码-到目前为止，我只编写了第一行的代码；在添加代码以格式化第二行之前，我想让它工作。当它运行时 - （在中断模式下）指定的字符串实际上没有被选中 - 选择只是保留为单元格的内容，并且格式应用于所有标题文本。

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

标签： vbams-word

解决方案

只需使用所需的页眉/页脚布局创建一个新文档，然后使用 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 允许），并且目标文档中的所有页眉都将更新以匹配源文档的主要页眉和页脚。

如果您只想更新第一个部分，请将“For Each Sctn In .Sections”更改为“Set Sctn = .Sections.First”并删除相应的“Next”。

推荐阅读