possible 2003 to 2007 issue with macro to insert picture into cell

[kstrick9]

I'm trying to use the following macro from another site that is getting balked at (see RED). This macro came from an .xls file and I am using 2007. Anyone have any ideas or suggestions? Thanks

Option Explicit
' Developed by Contextures Inc.
' www.contextures.com
Sub PictureIntoComment()
Dim ch As ChartObject
Dim dWidth As Double
Dim dHeight As Double
Dim ws As Worksheet
Dim sName As String
Dim cmt As Comment
Dim sPath As String
Dim sFile As String
Dim rng As Range
Set ws = ActiveSheet
Set rng = ActiveCell
sPath = ThisWorkbook.Path & "\"
sName = InputBox("Name for picture file (no extension)", "File Name")
If sName = "" Then sName = "Picture_" & Format(Date, "yyyymmdd")
sFile = sPath & sName & ".gif"
dWidth = Selection.Width
dHeight = Selection.Height

Selection.Cut
Set ch = ws.ChartObjects.Add(Left:=rng.Left, Top:=rng.Top, _
Width:=dWidth, Height:=dHeight)
ch.Chart.Paste
rng.Activate
ch.Chart.Export sFile
ch.Delete
Set cmt = rng.AddComment
cmt.Text Text:=""
With cmt.Shape
.Fill.UserPicture sFile
.Width = dWidth
.Height = dHeight
End With
End Sub

 

[kstrick9]

Sorry...

Option Explicit
' Developed by Contextures Inc.
' [URL="http://www.contextures.com/"][COLOR=#49644e]www.contextures.com[/COLOR][/URL]
Sub PictureIntoComment()
Dim ch As ChartObject
Dim dWidth As Double
Dim dHeight As Double
Dim ws As Worksheet
Dim sName As String
Dim cmt As Comment
Dim sPath As String
Dim sFile As String
Dim rng As Range
Set ws = ActiveSheet
Set rng = ActiveCell
sPath = ThisWorkbook.Path & "\"
sName = InputBox("Name for picture file (no extension)", "File Name")
If sName = "" Then sName = "Picture_" & Format(Date, "yyyymmdd")
sFile = sPath & sName & ".gif"
    dWidth = Selection.Width
    dHeight = Selection.Height

    Selection.Cut
[COLOR=#ff0000]Set ch = ws.ChartObjects.Add(Left:=rng.Left, Top:=rng.Top, _
      Width:=dWidth, Height:=dHeight)[/COLOR]
    ch.Chart.Paste
    rng.Activate
    ch.Chart.Export sFile
    ch.Delete
    Set cmt = rng.AddComment
    cmt.Text Text:=""
    With cmt.Shape
      .Fill.UserPicture sFile
      .Width = dWidth
      .Height = dHeight
    End With
End Sub

 

[kstrick9]

Closed and open my workbook and the above code works properly. Please disregard this post. thanks