使用 VBA 删除和添加括号特殊字符前后的空格

Removing and adding spaces before and after the parenthesis special character by using VBA

我正在尝试检查文本中括号的标点符号规则。我的目标是实现以下目标:

  1. Space 左括号前和右括号后
  2. 没有space在左括号后和括号前

如果文本已经符合上述条件,则忽略添加或删除 spaces。

我尝试了以下代码,该代码找到“(”并将其替换为“(”,即在左括号之前 space。当我 运行 这个时,PowerPoint 停止响应。

虽然有很多类似的问题,但我找不到使用VBA的解决方案。

Sub ReplaceSpaces()
Dim sld As Slide
Dim shp As Shape
Dim shpText As TextRange

For Each sld In ActivePresentation.Slides
    For Each shp In sld.Shapes
        If shp.HasTextFrame Then
            Set shpText = shp.TextFrame.TextRange

            Do While InStr(shpText.Text, "(") > 0
                shpText.Replace FindWhat:="( ", ReplaceWhat:=" ("
                shpText.Replace FindWhat:=" )", ReplaceWhat:=") "
            Loop

        End If
    Next shp
Next sld
End Sub

我 post 在您的主 post 下发表了评论,详细说明了 为什么 您的代码不起作用。下面的代码使用正则表达式将所有没有尾随 space 的左括号替换为带有尾随 space 的左括号。

如果您需要其他帮助,请回信。

Function FindAndReplace(testString As String, oSource As TextRange)
    Dim oReg As VBScript_RegExp_55.RegExp

    'Set oSource = ActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange

    Set oReg = New VBScript_RegExp_55.RegExp

    With oReg
        .Global = True
        .Multiline = False
        .IgnoreCase = True
        .Pattern = "(\()([^\s]+?)"  'Checks for an opening parenthesis with no following space
    End With

    If oReg.Test(testString) Then
        oSource.Text = oReg.Replace(testString, " ")
    End If
End Function

Sub ReplaceSpaces()
    Dim sld As Slide
    Dim shp As Shape
    Dim shpText As TextRange


    For Each sld In ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.HasTextFrame Then
                Set shpText = shp.TextFrame.TextRange

                FindAndReplace shpText.Text, shpText

            End If
       Next shp
     Next sld
 End Sub

这是一个不使用正则表达式的解决方案,因为如果您需要支持 MAC。
可能会很复杂 首先,它确保(之前有一个 space 和)之后有一个 space。
然后它删除多余的 spaces 之前(和之后)。
最后,删除(或之前)之后的任何 space。

Sub ReplaceSpaces()
Dim sld As Slide
Dim shp As Shape
Dim shpText As TextRange


For Each sld In ActivePresentation.Slides
    For Each shp In sld.Shapes
        If shp.HasTextFrame Then
            Set shpText = shp.TextFrame.TextRange

            shpText.Replace FindWhat:="(", ReplaceWhat:=" ("
            shpText.Replace FindWhat:=")", ReplaceWhat:=") "
            Do While InStr(shpText.Text, "  (") > 0
                shpText.Replace FindWhat:="  (", ReplaceWhat:=" ("
            Loop
            Do While InStr(shpText.Text, "( ") > 0
                shpText.Replace FindWhat:="( ", ReplaceWhat:="("
            Loop
            Do While InStr(shpText.Text, ")  ") > 0
                shpText.Replace FindWhat:=")  ", ReplaceWhat:=") "
            Loop
            Do While InStr(shpText.Text, " )") > 0
                shpText.Replace FindWhat:=" )", ReplaceWhat:=")"
            Loop

        End If
   Next shp
 Next sld
 End Sub