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 ===
|