Deleting Pictures to reduce workbook size

[Guest]

I have 16 almost identical workbooks about 8MB each.
A few offending workbooks are 11MB to 13MB.
I suspect that these larger file sizes are caused by numerous unwanted
"Pictures".
I need a way to delete them easily & quickly versus recreating the offending
workbook by using an 8MB file as the starting point.

The history:
Workbook 01 is a model that requires my copying an "area" from a page on our
supplier's website and pasting this "area" into a worksheet - the pasted area
takes up 9 columns by 34 rows and contains text, numbers, and pictures.
There are ten such worksheets, and, thus, ten such pastings per workbook.
Workbook 02 was created by taking Workbook 01 and clearing the 9C x 34R
areas to ready for new pastings. Unfortunately, this won't remove the
pictures.
By the time one gets to Workbook 16 there are many accumulated pictures.

The problem:
How to delete these pictures without highly repetitive clicking on the
picture and pressing the delete button. The Name Box next to the Formula Bar
shows "Picture 12000" and other equally large numbers, so, somehow, I've
accumulated a lot of pictures.

Thank you.
Stephen Powell

 

[Guest]

Hi Stephen:

This little sub will remove all pictures on all worksheets in a workbook:


Sub pic_puller()
Dim w As Worksheet
For Each w In ActiveWorkbook.Worksheets
w.Activate
pCount = w.Shapes.Count
If pCount > 0 Then
For i = pCount To 1 Step -1
w.Shapes(i).Select
Selection.Cut
Next
End If
Next
End Sub

 

[Guest]

Gary:
I'm a macro dummy but I know whom to ask in our office.
Your reply put me on the right track.
With a few modifications for my particular application your suggestion was
the perfect start.
Thank you very much.
FYI here is what we ending up with:
Sub pic_puller()
Dim w As Worksheet
For Each w In ActiveWorkbook.Worksheets
If Len(w.Name) < 6 And w.Name <> "Unit#" Then
w.Activate
pCount = w.Shapes.Count
If pCount > 0 Then
For i = pCount To 1 Step -1
w.Shapes(i).Select
Selection.Cut
Next
End If
End If
Next
End Sub


:

Hi Stephen:
This little sub will remove all pictures on all worksheets in a workbook:
Sub pic_puller()
Dim w As Worksheet
For Each w In ActiveWorkbook.Worksheets
w.Activate
pCount = w.Shapes.Count
If pCount 0 Then
For i = pCount To 1 Step -1
w.Shapes(i).Select
Selection.Cut
Next
End If
Next
End Sub
--
Gary's Student


:
I have 16 almost identical workbooks about 8MB each.
A few offending workbooks are 11MB to 13MB.
I suspect that these larger file sizes are caused by numerous unwanted
"Pictures".
I need a way to delete them easily & quickly versus recreating the offending
workbook by using an 8MB file as the starting point.
The history:
Workbook 01 is a model that requires my copying an "area" from a page on our
supplier's website and pasting this "area" into a worksheet - the pasted area
takes up 9 columns by 34 rows and contains text, numbers, and pictures.
There are ten such worksheets, and, thus, ten such pastings per workbook.
Workbook 02 was created by taking Workbook 01 and clearing the 9C x 34R
areas to ready for new pastings. Unfortunately, this won't remove the
pictures.
By the time one gets to Workbook 16 there are many accumulated pictures.
The problem:
How to delete these pictures without highly repetitive clicking on the
picture and pressing the delete button. The Name Box next to the Formula Bar
shows "Picture 12000" and other equally large numbers, so, somehow, I've
accumulated a lot of pictures.
Thank you.
Stephen Powell

 

[Don Guillett]

To delete all shapes
one sheet
For Each S In ActiveSheet.Shapes
S.Cut
Next

all sheets
for each ws in thisworkbook.worksheets
For Each S In ws.Shapes
S.Cut
next s
next ws

 

[Guest]

You are very welcome.