Public Sub Add_Shape_As_Comment_Picture()
Dim QRcode As Shape
Dim tempImageFullName As String
Set QRcode = Worksheets("Barcodes").Shapes("$B$1")
tempImageFullName = Environ("temp") & "\" & QRcode.Name & ".bmp"
Save_Object_As_Bitmap QRcode, tempImageFullName
Add_Comment_Picture Worksheets("Barcodes").Range("B7"), tempImageFullName, QRcode.Width, QRcode.Height
Kill tempImageFullName
End Sub
Private Sub Add_Comment_Picture(cell As Range, pictureFullName As String, pictureWidth As Single, pictureHeight As Single)
Dim cellComment As Comment
If Not cell.Comment Is Nothing Then cell.Comment.Delete
Set cellComment = cell.AddComment
'Add picture to comment
With cellComment
.Visible = True
With .Shape
.Left = cell.Left + 4
.Top = cell.Top + 4
.Width = pictureWidth
.Height = pictureHeight
.line.ForeColor.RGB = RGB(255, 255, 255) 'white to hide comment connector line
.Fill.Transparency = 0#
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Fill.UserPicture pictureFullName
End With
End With
End Sub
Private Sub Save_Object_As_Bitmap(saveObject As Object, imageFileName As String)
'Save a bitmap of an object as a BMP file
'Arguments
'saveObject - any object in the CopyPicture method's 'Applies To' list, for example a Range or Shape
'imageFileName - the .bmp file name (including folder path if required) the picture will be saved as
Dim temporaryChart As ChartObject
saveObject.CopyPicture xlScreen, xlBitmap
Set temporaryChart = ActiveSheet.ChartObjects.Add(0, 0, saveObject.Width, saveObject.Height)
With temporaryChart
.Activate 'Required, otherwise image is blank with Excel 2016
.Border.LineStyle = xlLineStyleNone 'No border
.Chart.Paste
.Chart.Export imageFileName
.Delete
End With
Set temporaryChart = Nothing
End Sub