I don't open other workbooks.

Maybe Joel will--or someone else will.

Or you can post a description in plain text.

Akader wrote:

thank you very much Joel & Dave
for you help, the code are not working as I like.

Please download my excel file example for what I need, I hope i will be
clear to you.

http://www.nouran.com/GetPhoto-temp.zip

----
open the attacfhed file,

to run the code / just click on any colume from B4 to B7 then click on (Get
photo) , the result will show in the same colume , I need to run the code on
all coulme with photo path all together after I click on Get photo.

----

Regards

Abdul Kader

"Dave Peterson" wrote:

I'm not sure what you're doing, but maybe something like:

Option Explicit
Sub GetPhoto()
Dim myPict As Picture
Dim myPictName As String
Dim rng As Range
Dim testStr As String

With ActiveSheet
For Each rng In .Range("AA1:AA50").Cells
If IsEmpty(rng.Value) Then
Exit For
End If

myPictName = rng.Value
testStr = ""
On Error Resume Next
testStr = Dir(myPictName)
On Error GoTo 0

If testStr = "" Then
MsgBox myPictName & " wasn't found!"
Else
Set myPict = .Parent.Pictures.Insert(Filename:=myPictName)

With rng.Offset(0, -1) 'column Z

myPict.Top = .Top
myPict.Left = .Left
myPict.Width = .Width
myPict.Height = .Height
myPict.Name = "Pict_" & .Address(0, 0)
End With
End If
Next rng
End With
End Sub



Akader wrote:

Dear all
I have below code to insert photo automatically to each line,

I need your help to add looping to the code to run same code each line till
the empty line.

Many thanks

Abdul kader

== her the code ==

Sub GetPhoto()
Dim myPict As Picture
Dim myPictName As String
Dim rng As Range

Set rng = ActiveCell
myPictName = rng
With ActiveSheet
With .Range("AA1:AA50")

If IsEmpty(ActiveCell) Then Exit Sub
On Error Resume Next
If IsEmpty(ActiveCell.Offset(-1, 0)) Then Set TopCell = ActiveCell Else
Set TopCell = ActiveCell.End(xlUp)
If IsEmpty(ActiveCell.Offset(1, 0)) Then Set BottomCell = ActiveCell
Else Set BottomCell = ActiveCell.End(xlDown)
Range(TopCell, BottomCell).Select

Set myPict = .Parent.Pictures.Insert(Filename:=myPictName)
rng.Select

myPict.Top = rng.Top
myPict.Left = rng.Left
myPict.Width = rng.Width
myPict.Height = rng.Height
myPict.Name = "Pict_" & .Cells(1).Address(0, 0)

End With
End With
End Sub

== end of the code ==

--

Dave Peterson


--

Dave Peterson