View Single Post
  #9   Report Post  
Posted to microsoft.public.excel.programming
Akader Akader is offline
external usenet poster
 
Posts: 21
Default Looping to insert photo

thank you guys
I find solution to my problem , here is the code just for your info.


==== start ===

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

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



For Each cl In Selection.Cells
cl.Activate

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

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


Next cl

End With
End With
End Sub

==== end ===