• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2918
  • Last Modified:

VBA code to delete a picture in a range

Could you get me VBA code to delete pictures in Range("X1:AC4") in excel 2003? thanks,
0
HemlockPrinters
Asked:
HemlockPrinters
  • 5
1 Solution
 
redmondbCommented:
Hi, HemlockPrinters.

pictures in Range("X1:AC4")
A picture is in the range if...
(1) ...any part of it is in the range.
(2) ...all of it is in the range.
(3) ...the top left corner is in the range.
(4) Something else?

Thanks,
Brian.
0
 
HemlockPrintersAuthor Commented:
all of it is in the range. thanks Brian.
0
 
redmondbCommented:
HemlockPrinters,

The code below uses (1) - let me know if you want that changed...
Sub Delete_Pictures_in_Range()
Dim xShape    As Shape
Dim xCount    As Long
Dim xResponse As Long

xResponse = MsgBox("About to delete all pictures in the range X1:AC in the active sheet (" & ActiveSheet.name & ")." _
                & Chr(10) & "'OK' to continue, 'Cancel' to terminate.", vbOKCancel, "Delete_Pictures_in_Range")
If xResponse = 2 Then
    MsgBox ("User chose to cancel - run terminating.")
    Exit Sub
End If

Application.ScreenUpdating = False

    For Each xShape In ActiveSheet.Shapes
        If xShape.Type = msoPicture Then
            If Not Intersect(Range("X1:AC4"), Range(xShape.TopLeftCell, xShape.BottomRightCell)) Is Nothing Then
                xCount = xCount + 1
                Debug.Print xCount & " - " & xShape.name & " - " & xShape.TopLeftCell.Address & " - " & xShape.BottomRightCell.Address
                xShape.Delete
            Else
                Debug.Print "** - " & xShape.name & " - " & xShape.TopLeftCell.Address & " - " & xShape.BottomRightCell.Address
            End If
        End If
    Next
    
Application.ScreenUpdating = True

MsgBox xCount & " picture(s) deleted."

End Sub

Open in new window

Regards,
Brian.
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
redmondbCommented:
Apologies, HemlockPrinters, crossing posts. I'll make the changes now.

Regards,
Brian.
0
 
redmondbCommented:
HemlockPrinters,

Please see below...
Sub Delete_Pictures_in_Range()
Dim xShape    As Shape
Dim xCount    As Long
Dim xResponse As Long
Dim xNot      As Boolean

xResponse = MsgBox("About to delete all pictures in the range X1:AC4 in the active sheet (" & ActiveSheet.name & ")." _
                & Chr(10) & "'OK' to continue, 'Cancel' to terminate.", vbOKCancel, "Delete_Pictures_in_Range")
If xResponse = 2 Then
    MsgBox ("User chose to cancel - run terminating.")
    Exit Sub
End If

Application.ScreenUpdating = False

    For Each xShape In ActiveSheet.Shapes
        If xShape.Type = msoPicture Then
            xNot = False
            If Not Intersect(Range("X1:AC19"), Range(xShape.TopLeftCell, xShape.BottomRightCell)) Is Nothing Then
                If Range(xShape.TopLeftCell, xShape.BottomRightCell).Address _
                = Intersect(Range("X1:AC19"), Range(xShape.TopLeftCell, xShape.BottomRightCell)).Address Then
                    xCount = xCount + 1
                    Debug.Print xCount & " - " & xShape.name & " - " & xShape.TopLeftCell.Address & " - " & xShape.BottomRightCell.Address
                    xShape.Delete
                Else
                    xNot = True
                End If
            Else
                xNot = True
            End If
            If xNot Then Debug.Print "** - " & xShape.name & " - " & xShape.TopLeftCell.Address & " - " & xShape.BottomRightCell.Address
        End If
    Next
    
Application.ScreenUpdating = True

MsgBox xCount & " picture(s) deleted."

End Sub

Open in new window

Regards,
Brian.
0
 
redmondbCommented:
Thanks, HemlockPrinters.
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now