Inserting Picture

[Pdj]

I am trying to insert a picture in certain positions relative to my active cell. I am working with the code below however I am having issues:

1. Sometimes the picture will insert higher than expected. I believe this has something to do with the height of the row but I am not sure.

2. I am new to VBA so most of my work is trial and error. I have had success adjusting the position by changing the offset on CenterH and CenterV

How should I go about changing the position? Is there a better way insert pictures?

Thanks!

Sub FrstRev_PYCHECK()
    InsertPicture "picture_path", _
        ActiveCell, True, True 'changed range to ActiveCell
End Sub

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 Dir(PictureFileName) = "" Then Exit Sub
    ' import picture
    Set p = ActiveSheet.Pictures.Insert(PictureFileName)
    ' determine positions
    With TargetCell
        t = .Top
        l = .Left
        If CenterH Then
            w = .Offset(0, -0.5).Left - .Left
            l = l + w / 2 - p.Width / 2
        End If
        If CenterV Then
            h = .Offset(-1, 0).Top - .Top
            t = t + h / 2 - p.Height / 2
        End If
    End With
    ' position picture
    With p
        .Top = t
        .Left = l
    End With
    Set p = Nothing
End Sub

 

[Domenic]

Maybe...

        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 [COLOR=#ff0000]p As Picture[/COLOR]
            If Dir(PictureFileName) = "" Then Exit Sub
            ' import picture
            Set p = ActiveSheet.Pictures.Insert(PictureFileName)
            [COLOR=#ff0000]With p
                ' center horizontal
                If CenterH Then
                    .Left = .Left + (TargetCell.Width - .Width) / 2
                End If
                ' center vertical
                If CenterV Then
                    .Top = .Top + (TargetCell.Height - .Height) / 2
                End If
            End With[/COLOR]
            Set p = Nothing
        End Sub

 

[Pdj]

This works well for the horizontal portion. I can adjust the " / 2" to move the picture as needed but the vertical portion doesn't change.

 

[Domenic]

Sorry, that should be...

        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 Picture
            If Dir(PictureFileName) = "" Then Exit Sub
            ' import picture
            Set p = ActiveSheet.Pictures.Insert(PictureFileName)
            With p
                ' center horizontal
                If CenterH Then
                    .Left = [COLOR=#ff0000]TargetCell[/COLOR].Left + (TargetCell.Width - .Width) / 2
                End If
                ' center vertical
                If CenterV Then
                    .Top = [COLOR=#ff0000]TargetCell[/COLOR].Top + (TargetCell.Height - .Height) / 2
                End If
            End With
            Set p = Nothing
        End Sub

Does this help?

 

[Pdj]

It is close to the solution. I should have specified that I want the picture to be inserted outside of my active cell. So for instance, I want it on the top left corner of my cell. The picture will need to be placed in certain spots around the active cell so I need to be able to adjust the position with the code. Horizontal works perfect but it is the vertical position that I can't make work. Maybe I am doing something wrong...

 

[Domenic]

Sorry, but it's not clear to me how you want the picture to be positioned. Can you please clarify?

 

[Pdj]

Thank you for being so helpful. I apologize if I didn't explain it well enough. I have attached an example. The picture is actually a tick mark (the red check mark with a line through it). Thanks for the help.

https://drive.google.com/file/d/0B2jiYTkn5EkxcUU0WWlBN3JaTzA/view?usp=sharing

 

[Domenic]

In that case, try...

            With p
                .Left = TargetCell.Left - .Width
                .Top = TargetCell.Top - .Height
            End With

Does this help?

 

[Pdj]

This is very nice! I have been playing with the code to try to better understand how it works. I have a few questions:

1. I tried swapping .left and .top with .right and .bottom. I assumed this would put the picture on the bottom right corner but I get an error. "Object doesn't support this property method."

2. Similarly, what if I you wanted to add it on top but center? bottom center? left bottom corner?


Thanks again for your help. I am learning a lot.

 

[Domenic]

For the bottom right corner...

            With p
                .Left = TargetCell.Left + TargetCell.Width
                .Top = TargetCell.Top + TargetCell.Height
            End With

For the centered top...

            With p
                .Left = TargetCell.Left + (TargetCell.Width - .Width) / 2
                .Top = TargetCell.Top - .Height
            End With

For the centered bottom...

            With p
                .Left = TargetCell.Left + (TargetCell.Width - .Width) / 2
                .Top = TargetCell.Top + TargetCell.Height
            End With

For the bottom left corner...

            With p
                .Left = TargetCell.Left - .Width
                .Top = TargetCell.Top + TargetCell.Height
            End With