Question

以下代码在我使用“表单控件”按钮时有效，但我已更新我的工作表以使用命令按钮来使用用户表单。下面的代码将删除命令按钮和任何注释。有没有办法让它只删除图片？或将其有效范围限制为Range("A3:A1002")？或从代码中排除命令按钮/注释的方法？

Private Sub Remove_Images_Click()
'Remove Images
    Dim wks         As Worksheet
    Dim shp         As Shape
    Dim picArray()  As String
    Dim index       As Integer

    On Error GoTo ErrorHandler 
    Columns(1).Replace What:="No Picture Found", Replacement:=vbNullString, LookAt:=xlPart
    Set wks = ActiveSheet
    index = 1
    For Each shp In wks.Shapes

        If shp.Type <> msoFormControl Then
            ReDim Preserve picArray(1 To index)
            picArray(index) = shp.Name
            index = index + 1
        End If
    Next shp
    wks.Shapes.Range(picArray).Delete
ExitRoutine:
    Set wks = Nothing
    Set shp = Nothing
    Erase picArray
    ECT_Image_Template.Hide
    Exit Sub

ErrorHandler:
    MsgBox Prompt:="Unable to find photo", _
           Title:="An error occured", _
           Buttons:=vbExclamation
    Resume ExitRoutine
End Sub

Answer 1

检查亮度属性以仅删除图片：

Private Sub Remove_Images_Click()
'Remove Images
    Dim wks         As Worksheet
    Dim shp         As Shape
    Dim picArray()  As String
    Dim count       As Integer
    Dim bightness   As Variant

    On Error GoTo ErrorHandler
    columns(1).Replace What:="No Picture Found", Replacement:=vbNullString, LookAt:=xlPart
    Set wks = ActiveSheet

    ReDim picArray(0 To wks.shapes.count)

    On Error Resume Next
    For Each shp In wks.shapes
        bightness = shp.PictureFormat.Brightness
        If bightness Then
          bightness = Empty
          picArray(count) = shp.Name
          count = count + 1
        End If
    Next
    On Error GoTo ErrorHandler

    If count Then
      ReDim Preserve picArray(0 To count - 1)
      wks.shapes.Range(picArray).Delete
    End If

ExitRoutine:
    ECT_Image_Template.Hide
    Exit Sub

ErrorHandler:
    On Error GoTo 0
    MsgBox Prompt:="Unable to find photo", _
           Title:="An error occured", _
           Buttons:=vbExclamation
    Resume ExitRoutine
End Sub

如何防止命令按钮和注释被删除？

1 个答案: