how can I insert photo within cell ranges by giving path and photo name using VBA ?

[wai yan]

Here is my code !! In my code, there is no error but doesn't effect, I dont know why ? Appreciate for any idea.

Sub InsertPicture(PictureFileName As String, TargetCell As Range, _
CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(Sheet3) <> "Worksheet" Then Exit Sub
MsgBox ("Error 1 Clear")
If Dir(PictureFileName) = "" Then Exit Sub
MsgBox ("Error 2 Clear")
' import picture
Set p = Sheet3.Pictures.Insert(PictureFileName)
' determine positions
With TargetCell
t = .Top
l = .Left
If CenterH Then
w = .Offset(0, 1).Left - .Left
l = l + w / 2 - p.Width / 2
If l < 1 Then l = 1
End If
If CenterV Then
h = .Offset(1, 0).Top - .Top
t = t + h / 2 - p.Height / 2
If t < 1 Then t = 1
End If
End With
' position picture
With p
.Top = t
.Left = l
End With
Set p = Nothing
End Sub

 

[DanteAmor]

Try this:

Sub InsertPicture(PictureFileName As String, TargetCell As Range, _
    CenterH As Boolean, CenterV As Boolean)
    ' inserts a picture at the top left position of TargetCell
    ' the picture can be centered horizontally and/or vertically
    Dim p As Object, t As Double, l As Double, w As Double, h As Double
    If TypeName(Sheet3) <> "Worksheet" Then Exit Sub
    If Dir(PictureFileName) = "" Then Exit Sub
    ' import picture
    Set p = Sheet3.Pictures.Insert(PictureFileName)
    ' determine positions
    With TargetCell
        t = .Top
        l = .Left
        If CenterH Then
            w = .Width
            If p.Width < w Then l = .Left + (w - p.Width) / 2
        End If
        If CenterV Then
            h = .Height
            If p.Height < h Then t = .Top + (h - p.Height) / 2
        End If
    End With
    With p
        .Top = t
        .Left = l
    End With
    Set p = Nothing
End Sub

It shows like this