Selecting and cutting unknown picture numbers from a specifc range of cells

[DonFlak]

I have a range of cells B5:H5. Each has a different picture in it but
the picture numbers vary and change on a regular basis.

I need to write a macro that will select all seven pictures (1 per
cell) so I can cut or delete them. I can't say to select or cut a
specific picture number from the cell because as I said, they change
on regular basis and are not constant. The constant is the cell
reference. Any assistance is greatly appreciated.

Don

 

[JE McGimpsey]

Since pictures exist in the drawing layer, not in cells, you can't use
the cell references directly. However, if all your pictures fit *over*
(or in front of, depending on your perspective) those cells, this may
work:


Public Sub DeleteSomePictures()
Dim rDeleteCells As Range
Dim pic As Picture

Set rDeleteCells = Sheets("Sheet1").Range("B5:H5")
For Each pic In rDeleteCells.Parent.Pictures
With pic
If Not Intersect(.TopLeftCell, rDeleteCells) Is Nothing Then _
.Delete
End With
Next pic
End Sub

 

[DonFlak]

Since pictures exist in the drawing layer, not in cells, you can't use
the cell references directly. However, if all your pictures fit *over*
(or in front of, depending on your perspective) those cells, this may
work:

Public Sub DeleteSomePictures()
Dim rDeleteCells As Range
Dim pic As Picture

Set rDeleteCells = Sheets("Sheet1").Range("B5:H5")
For Each pic In rDeleteCells.Parent.Pictures
With pic
If Not Intersect(.TopLeftCell, rDeleteCells) Is Nothing Then _
.Delete
End With
Next pic
End Sub





- Show quoted text -

That worked great. Is there a way to select the seven pictures, again
not knowing the picture numbers and moving them to another cell?
Example, I have just used your last reference to clear the cell (or
layer) for cells (B5:H5). I know want to select the pictures from
(B13:H13) and move them from (B13:H13) to the now empty (B5:H5).

Thanks as always for your tremendous assistance.

Don

 

[JE McGimpsey]

One way:

Public Sub TransferSomePictures()
Dim pic As Picture
Dim rFrom As Range
Dim rTo As Range
Dim rCell As Range

With Sheets("Sheet1").Range("B13:H13")
For Each pic In .Parent.Pictures
If Not Intersect(pic.TopLeftCell, .Cells) Is Nothing Then _
pic.Top = .Offset(-8, 0).Top
Next pic
End With
End Sub