EXCEL的搜索扩展-图形中搜索

最新推荐文章于 2022-02-23 18:28:18 发布

niulity

最新推荐文章于 2022-02-23 18:28:18 发布

阅读量1.3k

点赞数

分类专栏： VBA 文章标签：图形 excel 扩展 string function shapes

本文链接：https://blog.csdn.net/NcFire/article/details/4242365

版权

VBA 专栏收录该内容

5 篇文章 0 订阅

订阅专栏

原创：牛超

2009-06-04

OSAKA

EXCEL本身的搜索功能有限，如何定位到图形中的文字，工作中的问题。

试验了半天，解如下：

'find string from shapes in the worksheets with diagrams Function findInShape(str As String, Optional ByVal sel As Boolean = False) As String() Dim strret(1) As String Dim strget, strtmp, strdd As String strret(0) = "" strret(1) = "" strtmp = "" strget = "" For Each ws In ThisWorkbook.Worksheets If ws.Index < 4 Then GoTo ConOuter End If For Each sh In ws.Shapes 'strshow = strshow + sh.AlternativeText On Error GoTo ConInner cnt = cnt + 1 'whether the shape type is AutoShape If sh.Type = msoAutoShape Then 'key process: get description from this AutoShape 'in order to skip line shape If Len(sh.AlternativeText) > 0 Then strget = sh.TextFrame.Characters.Caption If InStr(strget, str) <> 0 Then strtmp = sh.TopLeftCell.Address(False, False) If sel Then 'Ok , activate it! ws.Activate sh.TopLeftCell.Select sh.TopLeftCell.Activate 'continue ? If MsgBox(ws.Name + "!" + strtmp, vbOKCancel, "continue search?") = vbCancel Then Exit Function End If End If strret(0) = strret(0) + strget + ";" strret(1) = strret(1) + ws.Name + "!" + strtmp + ";" 'Exit For End If End If End If ConInner: Next ConOuter: Next If Len(strret(0)) > 0 Then strret(0) = Left(strret(0), Len(strret(0)) - 1) strret(1) = Left(strret(1), Len(strret(1)) - 1) Else strret(0) = "－" strret(1) = "－" End If findInShape = strret End Function