使用Textrange.replace时无法保持区分大小写

如何解决使用Textrange.replace时无法保持区分大小写

我希望所有人都过得好.. 我一直在尝试开发一个小的宏，该宏可以从PowerPoint演示文稿中找到某些单词，并使用方法用某些其他单词替换它们

TextRange.Replace(FindWhat:=FindString,Replacewhat:=ReplaceString,_
                  WholeWords:=True,MatchCase := False)

要求是ReplaceString应该与表示中要替换的单词具有相同的大小写敏感性。但是使用上述方法，ReplaceString的大小写始终保持不变（如先前定义）。我需要根据演示文稿中的FindString的情况对其进行更改。

例如，如果我的FindString是bridge，而ReplaceString是brg，则在我的演示文稿中，如果出现Bridge和BRIDGE，则应分别用Brg和BRG替换（但是，使用上述方法，它将使用brg替换Bridge和BRIDGE） ）

我希望我的查询有意义。

有人可以帮我吗？

谢谢 问候

解决方法

我认为您可以实现此目标，但是.Replace不能实现。有必要将查找和替换步骤分开，以便您可以在两者之间检查找到的内容，然后使用类似的文本大小写替换（例如，大写，小写或“适当”）。

关键是使用InStr函数，因为它允许您查找任何文本大小写，同时还允许您设置查找开始索引并返回找到的匹配项的索引-这样您就可以循环进行一次每场比赛。然后，要查找文本大小写，请在匹配的每个字符之间循环，上下计数；并进行相应的替换。

Public Function ReplaceMatchCase(str,find,replace) As String
    Dim lenStr As Long
    Dim lenFind As Long
    Dim i As Long
    Dim j As Long
    Dim countUpper As Long
    Dim countLower As Long
    Dim chr As String
    
    i = 1
    lenStr = Len(str)
    lenFind = Len(find)
    
    If lenFind = 0 Or lenStr = 0 Or lenStr < lenFind Then
        ReplaceMatchCase = str
        Exit Function
    End If
    
    'Loop through each match
    Do
        i = InStr(i,str,vbTextCompare)
        
        If i = 0 Then
            Exit Do
        End If
        
        countUpper = 0
        countLower = 0
        
        'Loop through chars in each match
        For j = i To i + lenFind - 1
            chr = Mid(str,j,1)
            If chr = UCase(chr) Then
                countUpper = countUpper + 1
            Else
                countLower = countLower + 1
            End If
        Next j
        
        'Replace
        If countUpper <> 0 And countLower = 0 Then
            'Uppercase
            str = Mid(str,1,i - 1) & UCase(replace) & Mid(str,i + lenFind)
        
        ElseIf countUpper = 0 And countLower <> 0 Then
            'Lowercase
            str = Mid(str,i - 1) & LCase(replace) & Mid(str,i + lenFind)
        
        Else
            'Mixed - assume 'proper' case - can change this according to need
            str = Mid(str,i - 1) & UCase(Mid(replace,1)) & LCase(Mid(replace,2)) & Mid(str,i + lenFind)
        End If
        
    Loop While i <> 0
    
    ReplaceMatchCase = str
End Function

您可以像这样测试功能：

Sub Test()
    Debug.Print ReplaceMatchCase("I walked to the furthest bridge and on the way I passed the first BRIDGE and the second Bridge.","Bridge","Brg")
End Sub

'I walked to the furthest brg and on the way I passed the first BRG and the second Brg.

在PowerPoint中，您将使用以下功能：

TextRange.Text = ReplaceMatchCase(TextRange.Text,FindString,ReplaceString)

,

这是一个简单的例子。在尝试任何替换之前，它会检查是否在文本范围内根本找不到该词：这应该可以解决您的一些性能问题。能够使用WholeWords:=True的优点是可以防止替换较长单词的子字符串。

Sub Tester()

    Dim tr As TextRange
    
    Set tr = ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange
    
    DoReplace tr,"bridge","brg"
    
End Sub

Sub DoReplace(tr As TextRange,findThis,replaceWith)
    If InStr(1,tr.Text,vbTextCompare) > 0 Then 'is the word found at all?
        'found at least one case form - just try to replace any case form found...
        tr.Replace findWhat:=LCase(findThis),Replacewhat:=LCase(replaceWith),_
                  WholeWords:=True,MatchCase:=True
        tr.Replace findWhat:=UCase(findThis),Replacewhat:=UCase(replaceWith),MatchCase:=True
        tr.Replace findWhat:=StrConv(findThis,vbProperCase),_
                   Replacewhat:=StrConv(replaceWith,MatchCase:=True
    End If
End Sub