VBA 宏替换文本

Question

我正在尝试创建一个宏，提示用户编辑 Word 文档中的某些行。该宏的目的是让用户只需更改这些行的内容，而不会弄乱任何格式。我试图避免用户在报告不需要的地方添加制表符/回车符/空格等的情况。有一个存在的模板，他们应该只编辑内容。我还希望提示用户编辑这些特定行，因为过去报告的某些行尚未更改。下面是我现有的代码。我遇到的问题是，由于我需要删除当前行并将其替换为重建的文本字符串，因此所有格式（字体大小、颜色、对齐方式）都将被删除。这将导致默认格式（不同的字体大小、颜色和对齐方式）。我想保持这种格式。

提前感谢您的帮助

生成的输出是右对齐的文本，默认为 calibri（正文）11 点字体。我想要的输出是我的匹配模板（Arial，各种行加粗，某些行具有不同的字体大小，某些行具有不同的颜色并且所有文本都右对齐）

Sub EditSpecificLinesOnFirstPage()
    ' Declare variables
    Dim headerText As String
    Dim para As Paragraph
    Dim lineIndex As Integer
    Dim response As String
    Dim targetLines As Variant
    Dim rebuiltText As String
    Dim editedText As String
    Dim paraIndex As Integer
    Dim originalText As String
   
    ' Define the specific line numbers to edit (1, 2, 5-12, 14, 15, 17, 19)
    targetLines = Array(1, 2, 5, 6, 7, 8, 9, 10, 11, 12, 14, 15, 17, 19)
   
    ' Step 1: Prompt the user to edit the header
    headerText = InputBox("Please enter the text for the header:", "Edit Header", ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text)
   
    ' If the user clicks Cancel or enters nothing, exit the macro
    If headerText = "" Then
        MsgBox "Header edit cancelled or no text entered.", vbInformation
        Exit Sub
    End If
   
    ' Set the header text of the primary header
    ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = headerText

    ' Step 2: Initialize the rebuiltText variable
    rebuiltText = ""
   
    ' Step 3: Loop through the paragraphs on the first page
    lineIndex = 1 ' Initialize line counter
    originalText = "" ' Store the original content
   
    For Each para In ActiveDocument.Paragraphs
        ' Stop once we reach the second page
        If para.Range.Information(wdActiveEndPageNumber) > 1 Then Exit For
       
        ' Store original text of the paragraph
        originalText = originalText & para.Range.Text
       
        ' Check if the current paragraph is one of the target lines for editing
        If IsInArray(lineIndex, targetLines) Then
            ' Prompt the user to edit the text of this specific line
            response = InputBox("Edit line " & lineIndex & " text (or leave blank to skip):" & vbCrLf & vbCrLf & para.Range.Text, _
                                "Edit Line " & lineIndex, para.Range.Text)
           
            ' If the user entered text, update the line
            If response <> "" Then
                rebuiltText = rebuiltText & response & vbCrLf
            Else
                rebuiltText = rebuiltText & para.Range.Text
            End If
        Else
            ' If not an editable line, just append the original text (with its paragraph break)
            rebuiltText = rebuiltText & para.Range.Text
        End If
       
        ' Increment the line index counter
        lineIndex = lineIndex + 1
    Next para
   
    ' Step 4: Replace the entire document content with the rebuilt text
    ActiveDocument.Content.Delete ' Clear current content
    ActiveDocument.Content.InsertAfter rebuiltText ' Insert updated content
   
    ' Completion message
    MsgBox "Editing of specified lines on the first page is complete.", vbInformation
End Sub

' Helper function to check if an item is in an array
Function IsInArray(val As Variant, arr As Variant) As Boolean
    Dim element As Variant
    IsInArray = False
    For Each element In arr
        If element = val Then
            IsInArray = True
            Exit Function
        End If
    Next
End Function

Answer 1

您可以打开自己的自定义对话框窗体，该窗体使用 Richtextbox 控件而不是简单的文本框，而不是调用 InputBox。

请参阅 https://learn.microsoft.com/en-us/office/vba/word/concepts/customizing-word/creating-a-custom-dialog-box

在模块顶部创建一个名为 strRichResponse 的公共变量来存储自定义 RichInputBox 的返回值。

Public strRichResponse As String

在 RichInputBox 的 Close 事件中设置 strRichResponse = txtRichTextBox1.Text。对话框关闭后使用 strRichResponse 而不是响应。

编辑您的子程序以使用自定义 RichInputBox

Sub EditSpecificLinesOnFirstPage() 
    ...
    If IsInArray(lineIndex, targetLines) Then
    
     With RichInputBox
       .lblPrompt.Text="Edit line " & lineIndex & " text (or leave blank to skip):" & vbCrLf & vbCrLf & para.Range.Text                              "Edit Line " & lineIndex
       .txtRichTextBox1.Text=para.Range.Text
       .Show 
     End With 
    
     ' If the user entered text, update the line
     If response <> "" Then
        rebuiltText = rebuiltText & strRichResponse & vbCrLf
     Else
        rebuiltText = rebuiltText & para.Range.Text
     End If
    
    else
    ...