使用 VBA 删除和添加括号特殊字符前后的空格
Removing and adding spaces before and after the parenthesis special character by using VBA
我正在尝试检查文本中括号的标点符号规则。我的目标是实现以下目标:
- Space 左括号前和右括号后
- 没有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
我正在尝试检查文本中括号的标点符号规则。我的目标是实现以下目标:
- Space 左括号前和右括号后
- 没有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