help with VBA click on cell to add picture

[toanhung]

as soon im select picture it give me error

Run-time error 1004
The specified value is out of range.

thank for any help...

Private Sub Worksheet_SelectionChange(ByVal target As Range)If target.Address = "$F$5" Or target.Address = "$F$6" Or target.Address = "$F$7" Or target.Address = "$F$8" Or target.Address = "$F$9" Or target.Address = "$F$10" Or target.Address = "$G$5" Or target.Address = "$G$6" Or target.Address = "$G$7" Or target.Address = "$G$8" Or target.Address = "$G$9" Or target.Address = "$G$10" Then
PicLocation = Application.GetOpenFilename("Image Files (*.jpg),*.jpg", , "Select Image File", , "False")
ActiveSheet.Shapes.AddPicture(PicLocation, False, True, 10, 10, 10, 10).Select
With Selection.ShapeRange
   ' Align picture to top left of range
    .LockAspectRatio = msoFalse
    .Height = ActiveCell.Height
    .Width = ActiveCell.Width
    .Top = ActiveCell.Top
    .Left = ActiveCell.Left
End With
End If
End Sub

 

[RickXL]

Hi and welcome to the MrExcel Message Board.

It seems to be working for me.

When you get the error message which line does it highlight if you hit the Debug button?

 

[toanhung]

Hi Rick
following line are highlighted

ActiveSheet.Shapes.AddPicture(PicLocation, False, True, 10, 10, 10, 10).Select

 

[toanhung]

got thing figure out , thanks rick

 

[RickXL]

Thanks for letting me know. What was the problem?

By the way, some of your code can be tidied up a bit and made shorter.

Regards,

 

[toanhung]

i got bunch more code on multiple worksheet , seen like it conflicting , just clear out some code now problem resolved.
but if you would show me how to tidy up the code to made it shorter that would be awsome and thanks

 

[RickXL]

OK, no problem.

I think I would do it more like this:

Private Sub oWorksheet_SelectionChange(ByVal Target As Range)
    Dim PicLocation As String
    If Not Intersect(Target, Range("F5:G10")) Is Nothing And Target.Count = 1 Then
        PicLocation = Application.GetOpenFilename("Image Files (*.jpg),*.jpg", , "Select Image File", , "False")
        With Me.Shapes.AddPicture(PicLocation, False, True, 10, 10, 10, 10)
            ' Align picture to top left of range
             .LockAspectRatio = msoFalse
             .Height = Target.Height
             .Width = Target.Width
             .Top = Target.Top
             .Left = Target.Left
        End With
    End If
End Sub

Intersect(Target, Range("F5:G10")) creates a Range Object where the two ranges (Target and Range("F5:G10")) overlap. If they do not overlap then the Range gets set to Nothing. So if the answer is Not Nothing then we know they overlap.

Also, I have removed the need to use Select which will save a small amount of time each time it is run.

The Target.Count = 1 part checks that only one cell was selected.

Regards,