Referencing pictures

[Guest]

Hi,
I've many pictures in my sheets. I've 2 questions related this.
- I know that pictures have height&width property linked with cells. I guess
that a pictures is anchored with its top-left corner over a cell. If so, how
can get the cell reference of a pic (or how to learn where pic is in terms of
cell ref)?
- I do not follow how pictures are automatically named during picture
insertion. So, my pictures do not have specific names. In this condition, how
can I handle them one by one in vba.
Many thanks for your support,
PalyanJoe

 

[Dave Peterson]

If you're adding the pictures via code, you can do something like:

Option Explicit
Sub testme01()

Dim myPict As Picture
Dim myPictName As String

myPictName = "C:\test.jpg"

With ActiveSheet
With .Range("a1:b9")
Set myPict = .Parent.Pictures.Insert(Filename:=myPictName)
myPict.Top = .Top
myPict.Left = .Left
myPict.Width = .Width
myPict.Height = .Height
myPict.Name = "Pict_" & .Cells(1).Address(0, 0)
End With
End With
End Sub


If the pictures are already on the sheet:

Option Explicit
Sub testme02()

Dim myPict As Picture
For Each myPict In ActiveSheet.Pictures
MsgBox myPict.TopLeftCell.Address(0, 0) & vbLf _
& myPict.BottomRightCell.Address(0, 0) & vbLf _
& myPict.Name
Next myPict
End Sub

And if you're adding the pictures manually, you can select a picture and type
its new name in the namebox (to the left of the formulabar). Remember to hit
enter when you've finished typing the new name.

 

[Guest]

Many thx, it gave me the idea...

"Dave Peterson":

 

[Guest]

Hello again,
After your suggestions, I wrote the below codes, but it gives 1004 RUN TIME
ERROR in the ".Top = myTop" code after pasting.
In summary, one by one I Cut&PasteSpecial (as jpeg) all of the pictures on
the sheet. After pasting, as the location of the pic is changed, I assign
initial position values to variables to relocate it to its original position.
But relocation does not work.
Thx in advance for your support,
PalyanJoe

Sub MacroSS()

Dim myPict As Picture
Dim wks As Worksheet
Dim myTop As Double
Dim myWidth As Double
Dim myHeight As Double
Dim myLeft As Double
Dim myName As String

For Each wks In ActiveWorkbook.Worksheets
For Each myPict In wks.Pictures
With myPict
myTop = .Top
myWidth = .Width
myLeft = .Left
myHeight = .Height
myName = .Name
.Cut
ActiveSheet.PasteSpecial Format:="Picture (JPEG)",
Link:=False, _
DisplayAsIcon:=False
.Top = myTop
.Width = myWidth
.Left = myLeft
.Height = myHeight
.Name = myName
End With
Next myPict
Next wks
End Sub

 

[Ken Johnson]

Hi Palyan Joe,

I'm not sure about what you are trying to do, but I think I can see the
reason for the error.
Excel is complaining that an Object is required, and with very good
reason, the object that you had Excel working on has been Cut, and so
no longer exists!

I think that the new object that you are wanting Excel to work on is
the Picture resulting from the PasteSpecial method, and luckily, after
being pasted onto the sheet it is selected, and can therefore be
referred to as the Selection object.

Try this to see if it gives the desired result...

Sub MacroSS()

Dim myPict As Picture
Dim wks As Worksheet
Dim myTop As Double
Dim myWidth As Double
Dim myHeight As Double
Dim myLeft As Double
Dim myName As String
Dim MyNewPict As Picture
For Each wks In ActiveWorkbook.Worksheets
For Each myPict In wks.Pictures
With myPict
myTop = .Top
myWidth = .Width
myLeft = .Left
myHeight = .Height
myName = .Name
.Cut
End With
ActiveSheet.PasteSpecial Format:="Picture
(JPEG)", Link:=False, _
DisplayAsIcon:=False
With Selection
.Top = myTop
.Width = myWidth
.Left = myLeft
.Height = myHeight
.Name = myName
End With
Next myPict
Next wks
End Sub

Ken Johnson

 

[Guest]

Thank you very much. This was the point where I got stuck for days. Your
detailed explanation clarified, where the code fails and how it behaves.
Thanks for your kind interest.
PalyanJoe

"Ken Johnson":

 

[Ken Johnson]

Hi PalyanJoe,

You're welcome, thanks for the feedback.

Ken Johnson