Hi
Try this version.
Note: It works in 2003, not sure on older versions.Code:Function INSERTPICTURE(ByVal PictureFullName As String, Optional ByVal PicWidth As Single = 200, _ Optional ByVal PicHeight As Single = 150) As Boolean '// Author : Kris @ ExcelFox.com Dim CA As Range Dim picPicture Set CA = Application.Caller If Val(Application.Version) < 12 Then For Each picPicture In ActiveSheet.Shapes If picPicture.TopLeftCell.Address = CA.Address Then If picPicture.Type = msoLinkedPicture Then picPicture.Delete Exit For End If End If Next Set picPicture = ActiveSheet.Shapes.AddPicture(PictureFullName, 1, 0, CA.Left, CA.Top, PicWidth, PicHeight) GoTo Finish End If For Each picPicture In ActiveSheet.Pictures If picPicture.TopLeftCell.Address = CA.Address Then picPicture.Delete Exit For End If Next Set picPicture = ActiveSheet.Pictures.Insert(PictureFullName) With picPicture .Left = CA.Left + 1 .Top = CA.Top + 1 .Width = PicWidth .Height = PicHeight End With INSERTPICTURE = True Exit Function Finish: INSERTPICTURE = True End Function




Reply With Quote

Bookmarks