Solved

VBA code to delete a picture in a range

Posted on 2013-01-09
6
2,221 Views
Last Modified: 2013-01-09
Could you get me VBA code to delete pictures in Range("X1:AC4") in excel 2003? thanks,
0
Comment
Question by:HemlockPrinters
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
6 Comments
 
LVL 26

Expert Comment

by:redmondb
ID: 38760934
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
 

Author Comment

by:HemlockPrinters
ID: 38761011
all of it is in the range. thanks Brian.
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38761013
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
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 26

Expert Comment

by:redmondb
ID: 38761023
Apologies, HemlockPrinters, crossing posts. I'll make the changes now.

Regards,
Brian.
0
 
LVL 26

Accepted Solution

by:
redmondb earned 500 total points
ID: 38761064
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
 
LVL 26

Expert Comment

by:redmondb
ID: 38761145
Thanks, HemlockPrinters.
0

Featured Post

[Webinar] Code, Load, and Grow

Managing multiple websites, servers, applications, and security on a daily basis? Join us for a webinar on May 25th to learn how to simplify administration and management of virtual hosts for IT admins, create a secure environment, and deploy code more effectively and frequently.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

734 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question