Solved

VBA code to delete a picture in a range

Posted on 2013-01-09
6
2,052 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 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

Networking for the Cloud Era

Join Microsoft and Riverbed for a discussion and demonstration of enhancements to SteelConnect:
-One-click orchestration and cloud connectivity in Azure environments
-Tight integration of SD-WAN and WAN optimization capabilities
-Scalability and resiliency equal to a data center

Question has a verified solution.

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

Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

766 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