Posted to microsoft.public.excel.programming
|
|
Looping to insert photo
Maybe someone else will volunteer.
Good luck.
Akader wrote:
thank Dave
why i need you to open my file, just to see the real example.
because maybe i not able to description my request very well.
once again thanks
"Dave Peterson" wrote:
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
--
Dave Peterson
|