检查excel范围是否有VBA的形状答案

【问题标题】：Check if excel range has shape with VBA检查excel范围是否有VBA的形状
【发布时间】：2021-04-14 14:08:44
【问题描述】：

您好，我正在尝试处理从第三方下载的表格，该表格使用刻度（形状）而不是单元格中的文本。形状没有文本框字符。我无法过滤 excel 中的刻度，所以我想用文本替换，例如是的。这是我的工作代码，但由于对象错误而出现运行时错误 438 我尝试了 excel vba 对象模型但无法使其工作。 VBE 似乎没有 Selection.ShapeRange

https://docs.microsoft.com/en-us/office/vba/api/excel.shape

https://docs.microsoft.com/en-us/office/vba/api/excel.shaperange

这是我的代码

Sub ReplaceShapeswithYes()

' Inserts text where a shape exists

Dim ws As Worksheet
Dim NumRow As Integer
Dim iRow As Integer
Dim NumShapes As Long

Set ws = ActiveSheet

NumRow = ws.UsedRange.Rows.Count

For iRow = 2 To NumRow
    
    Cells(iRow, 10).Select
    'NumShapes = ActiveWindow.Selection.ShapeRange.Count ' tried both
    NumShapes = Windows(1).Selection.ShapeRange.Count
    
    If NumShapes > 0 Then
    Cells(iRow, 10).Value = "Yes"
    End If
            
Next iRow

End Sub

非常感谢

【问题讨论】：

要迭代形状集合，同时仍然能够删除形状，您需要返回 for s = shapes.count to 1 step -1。但是，找出形状在哪一行是艺术而非科学——您需要shapes(s).top 并将其与每一行的top 进行比较。它会工作，但有点hacky。如果你能得到没有形状的数据就更好了。顺便说一句，它们是绝对形状（例如，您可以拖动它们）还是 Acii 中的文本字符或类似字符？
肯定是形状，因为我有其他代码循环收集并删除它们。我可能正在使用 TopLeftCell 属性，但似乎无法选择然后使用它来插入 Yes 文本
您的回答是恰当的 - 没有必要（而且几乎从来都不是一个好主意）选择一个单元格，只需为其赋值即可。很高兴你到了那里。

标签： excel vba

【解决方案1】：

要获取工作表的所有形状，只需遍历工作表的Shapes-集合即可。

可以使用TextFrame.Characters.Text 读取形状的文本，但为了保存，您需要检查形状是否真的有文本（有些形状没有文本），请参阅@987654321 @

要使用工作表获取位置，请使用TopLeftCell-property。

以下代码会将所有形状的文本复制到工作表中并删除形状：

Sub shapeToText(Optional ws As Worksheet = Nothing)
    If ws Is Nothing Then Set ws = ActiveSheet
    
    Dim sh As Shape
    For Each sh In ws.UsedRange.Shapes
        If Not sh.TextFrame Is Nothing Then
            If sh.TextFrame2.HasText Then
                Dim s As String
                s = sh.TextFrame.Characters.Text
                sh.TopLeftCell = s
                sh.Delete
            End If
        End If
    Next
End Sub

【讨论】：

抱歉，Thomas 这些形状没有任何文字。

【解决方案2】：

这已经成功了

Sub ReplaceShapes()

'Replace all ticks with text

Dim NoShapes As Long
Dim iShape As Long
Dim ws As Worksheet
Dim r As Range
Dim Shp As Shape

Set ws = ActiveSheet

NoShapes = ws.Shapes.Count

For iShape = NoShapes To 1 Step -1:

Set Shp = ws.Shapes(iShape)

Set r = Shp.TopLeftCell

r.Value = "Yes"


Next iShape

End Sub

【讨论】：