Old notes/comment box macro not working after MS 365 upgrade

[MrzSanchez]

For years I've used the same code to insert pictures into cell comment boxes so that the image will pop-up when curser is over that particular cell. We were updated to Microsoft 365 and now it's inserting blank images.

Sub PictureIntoComment()
'Inserts picture into cell comment. 
'(1) Paste a picture/image anywhere in the active sheet,
'(2) click on the cell where you want picture inserted, 
'(3) click on the picture and 
'(4) run macro.

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 = ""
If sName = "" Then sName = "Picture_" & Format(Date, "ddmmyy")
sFile = sPath & sName & ".jpg"
    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
      Kill sFile
      .Width = dWidth
      .Height = dHeight
    End With

End Sub

 

[Alex Blakenburg]

The only way I could get it to work consistently is to add "both" of these after the Set ch = line.

    ch.Parent.Activate
    ch.Activate