Hi
I was using following macro code which was working perfectly for many years (Thanks for the contributor) downloaded from the forum. Now I have upgraded my Excel to 365 Office 2016. Now when I run the Macro I can see in the comment a blank picture. Will some one please help me resolve this. This I need urgently. I do not think there is any thing wrong in the code.
Thanks
Prakash
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
I was using following macro code which was working perfectly for many years (Thanks for the contributor) downloaded from the forum. Now I have upgraded my Excel to 365 Office 2016. Now when I run the Macro I can see in the comment a blank picture. Will some one please help me resolve this. This I need urgently. I do not think there is any thing wrong in the code.
Thanks
Prakash
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