在形状中搜索文本答案

【问题标题】：Search for text in shapes在形状中搜索文本
【发布时间】：2020-07-08 14:19:57
【问题描述】：

我想在 Excel 上搜索形状中的文本，我在 excel.tips.net 中找到了以下代码

Sub FindInShape1()
    Dim rStart As Range
    Dim shp As Shape
    Dim sFind As String
    Dim sTemp As String
    Dim Response

    sFind = InputBox("Search for?")
    If Trim(sFind) = "" Then
        MsgBox "Nothing entered"
        Exit Sub
    End If
    Set rStart = ActiveCell
    For Each shp In ActiveSheet.Shapes
        sTemp = shp.TextFrame.Characters.Text
        If InStr(LCase(sTemp), LCase(sFind)) <> 0 Then
            shp.Select
            Response = MsgBox( _
              prompt:=shp.Name & vbCrLf & _
              sTemp & vbCrLf & vbCrLf & _
              "Do you want to continue?", _
              Buttons:=vbYesNo, Title:="Continue?")
            If Response <> vbYes Then
                Set rStart = Nothing
                Exit Sub
            End If
        End If
    Next
    MsgBox "No more found"
    rStart.Select
    Set rStart = Nothing
End Sub

如果我搜索靠近工作表顶部形状的单词，它会起作用。但是，工作表很大，如果我在中间或底部搜索某些东西，就会出错；

运行时错误“-2147024809 (80070057)”：指定的值超出范围

我可以选择调试，这样做会突出显示代码行

sTemp = shp.TextFrame.Characters.Text

我使用的是 Excel 2010。

感谢您的帮助，

马蒂斯

【问题讨论】：

嗯，每个形状都包含文字吗？
@findwindow shp.TextFrame.Characters.Text 将导致大多数形状的错误...没有On Error Resume Next 我不确定如何在没有错误消息的情况下运行它
我尝试将 shp.TextFrame.Characters.Text 更改为 shp.TextEffect.Text 但没有成功

标签： excel vba search text

【解决方案1】：

这不是一个答案（但评论太多了）

请试试这个，看看是否仍然弹出错误：

Sub testForError()
  Dim shp As Shape, i As Long
  On Error Resume Next
  For Each shp In ActiveSheet.Shapes
    i = i + 1
    Debug.Print i & " " & shp.Type
    Debug.Print i & " " & shp.TextFrame.Characters.Text
    Debug.Print i & " " & shp.TextFrame2.TextRange.Text
  Next
  Debug.Print "finished"
End Sub

编辑
请尝试一下并告诉我是否弹出错误:)

Sub FindInShape1()
  Dim shp As Shape
  Dim sFind As String
  Dim sTemp As String
  sFind = InputBox("Search for?")
  If Trim(sFind) = "" Then MsgBox "Nothing entered": Exit Sub
  On Error Resume Next
  For Each shp In ActiveSheet.Shapes
    Debug.Print shp.TopLeftCell.Address
    sTemp = ""
    sTemp = shp.TextFrame.Characters.Text
    If Len(sTemp) Then
      If InStr(1, sTemp, sFind, 1) Then
        shp.Select
        If MsgBox(shp.Name & vbCrLf & sTemp & vbCrLf & vbCrLf & "Do you want to continue?", vbYesNo, "Continue?") <> vbYes Then Exit Sub
      End If
    End If
  Next
  MsgBox "No more found"
End Sub

【讨论】：

我运行了它，但它似乎没有做任何明显的事情。然后我运行原始代码，错误仍然存在。谢谢你的建议
@MatticeVerhoeven 在您的 VBA 窗口的直接窗口中应该有很多文本......最后的输出应该是“完成”......这告诉我们有一个不同的问题...
我对 VBA 很陌生，抱歉，我不确定直接窗口是什么。另外，我应该只运行上面的代码，还是将其包含在原始代码中？
@MatticeVerhoeven 作为一个额外的宏...在 VBA 窗口中转到“查看 =>> 直接窗口”或只需按 Ctrl + G ... 请尝试将新代码作为一个额外的宏（我仍然需要知道错误是否弹出以及崩溃前的最后一个输出）...
是的，我作为一个额外的宏运行，直接窗口中有很多文本，后面跟着“完成”。然后我再次运行原始代码并得到同样的错误。

【解决方案2】：

您忘记了必须在分配任何形状变量之前放置“set”。

Set sTemp = shp.TextFrame.Characters.Text

【讨论】：

那行代码捕获了一个String，其中包含形状中的文本，而不是对象，因此Set 在这里不合适。