Improve company productivity with a Business Account.Sign Up

x
?
Solved

VBA code to delete a picture in a range

Posted on 2013-01-09
6
Medium Priority
?
3,195 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
  • 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
Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
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 2000 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

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

As a person who answers a lot of questions, I often see code that could be simplified, made easier to read, and perhaps most importantly made easier to maintain if the code was modified to use the Select Case statement. This article explains how to…
Excel allows various different methods to link Excel files to each other. This includes relative paths, mapped drives (or the local drive) and UNC paths. UNC paths are the least robust of the three.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

589 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