Word VBA:查找行并替换字体 [英] Word VBA: find line and replace font

问题描述

我编写了一个VBA Word宏，该宏读取 .txt 文件，将其复制并粘贴到设置新字体的Word文档中.

I've written a VBA Word Macro that read a .txt File, copy it and paste it in a Word document setting a new font.

一切正常！现在，我想用 bold + italic 字体突出显示一些特定的行，但是我无法找到一个可行的解决方案.

All is working fine! Now I would like to highlight some specific lines with bold + italic font, but i cannot figure out a working solution.

特定行以特定单词开头(例如 Simulation Nr.xxx )，或者以某些单词开头，但随后它们有很长的空格序列(例如 Turbine).

The specific lines begins with a specific word (for example Simulation Nr.xxx) or they begin with some words but then they have a very long series of blank spaces (for example Turbine).

我该如何解决问题?

P.s .:此处是将.txt文件复制/粘贴到Word文档中的工作代码.

P.s.: here the working code that copy/paste the .txt file into a word document.

Sub ACTUS_Table_Converter()

Dim pName As String
Dim bDoc As Document
Dim AppPath, ThisPath As String
Dim Rng As Range

ThisPath = ActiveDocument.Path
pName = ActiveDocument.Name

With Dialogs(wdDialogFileOpen)
    If .Display Then
        If .Name <> "" Then
            Set bDoc = Documents.Open(.Name)
            AppPath = bDoc.Path
        End If
    Else
        MsgBox "No file selected"
    End If
End With

Call ReplaceAllxSymbolsWithySymbols
Call ChangeFormat

Selection.Copy
Windows(pName).Activate
Selection.Paste
Selection.Collapse
bDoc.Close savechanges:=False

End Sub

Sub ChangeFormat()

Selection.WholeStory
With Selection.Font
    .Name = "Courier New"
    .Size = 6
End With

End Sub

Sub ReplaceAllxSymbolsWithySymbols()

'Call the main "ReplaceAllSymbols" macro (below),
'and tell it which character code  and font to search for, and which to replace with

Call ReplaceAllSymbols(FindChar:=ChrW(-141), FindFont:="(normal text)", _
        ReplaceChar:=ChrW(179), ReplaceFont:="(normal text)")
Call ReplaceAllSymbols(FindChar:=ChrW(-142), FindFont:="(normal text)", _
        ReplaceChar:=ChrW(178), ReplaceFont:="(normal text)")
Call ReplaceAllSymbols(FindChar:=ChrW(-144), FindFont:="(normal text)", _
        ReplaceChar:=ChrW(176), ReplaceFont:="(normal text)")
Call ReplaceAllSymbols(FindChar:="°", FindFont:="(normal text)", _
        ReplaceChar:="", ReplaceFont:="(normal text)")

End Sub

Sub ReplaceAllSymbols(FindChar As String, FindFont As String, _
    ReplaceChar As String, ReplaceFont As String)

Dim FoundFont As String, OriginalRange As Range, strFound As Boolean
Application.ScreenUpdating = False

Set OriginalRange = Selection.Range
'start at beginning of document
ActiveDocument.Range(0, 0).Select

strFound = False
If ReplaceChar = "" Then
With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = FindChar
    .Replacement.Text = ReplaceChar
    .Replacement.Font.Name = "Courier New"
    .Replacement.Font.Size = 6
    .MatchCase = True
End With
If Selection.Find.Execute Then
    Selection.Delete Unit:=wdCharacter, Count:=2
    Selection.TypeText ("°C")
End If
Else
With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = FindChar
    .Replacement.Text = ReplaceChar
    .Replacement.Font.Name = "Courier New"
    .Replacement.Font.Size = 6
    .MatchCase = True
    .Execute Replace:=wdReplaceAll
End With
End If

OriginalRange.Select

Set OriginalRange = Nothing
Application.ScreenUpdating = True

Selection.Collapse

End Sub

推荐答案

以下代码应在文档中运行，以 Simulation Nr.开头的行并替换整个strong>粗体和斜体的线条字体.

The following code should run over the document, looking for line starts with Simulation Nr. and replace the whole line font with bold and italic.

Sub ReplaceLinesStartWith()

Dim startingWord As String
'the string to search for
startingWord = "Simulation Nr."

Dim myRange As range
'Will change selection to the document start
Set myRange = ActiveDocument.range(ActiveDocument.range.Start, ActiveDocument.range.Start)
myRange.Select

While Selection.End < ActiveDocument.range.End
   If Left(Selection.Text, Len(startingWord)) = startingWord Then
        With Selection.Font
            .Bold = True
            .Italic = True
        End With
    End If

    Selection.MoveDown Unit:=wdLine
    Selection.Expand wdLine

Wend

End Sub

请注意，我对要搜索的字符串进行了硬编码，您可以将其设置为函数参数.

Note that I hardcoded the string to search for, you can set it as function argument instead.

这篇关于Word VBA:查找行并替换字体的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！