Sub FileDialog_Pic_InComment_Scale()
'Jan 10, 2016
On Error Resume Next
Dim sClimax As Double
sClimax = 0.8   '<< change scale 0.5, 0.8, 1, 1.2

Dim dH As Double, dW As Double

Dim v

'#########
'change Dir
s = CurDir
ChDrive "E:\"   '<< change as needed
ChDir "E:\Folder A\Folder B\myPictures\"   '<< change as needed
'#########
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "please, select a picture"
.Filters.Add "Images", "*.bmg;*.gif;*.jpg;*.jpeg;*.png;*.tif;*.yuv", 1
.AllowMultiSelect = False
If .Show = True Then
Application.ScreenUpdating = False
v = .SelectedItems(1)
Set ws = ActiveSheet
Set p = ws.Shapes.AddPicture(v, msoFalse, msoTrue, [a1].Left, [a1].Top, -1, -1)
dH = p.Height * sClimax
dW = p.Width * sClimax
With ActiveCell
.Comment.Delete
With .AddComment
.Visible = True 'False
With .Shape
.LockAspectRatio = msoFalse
.Height = dH
.Width = dW
.Fill.UserPicture v
End With
End With
End With
p.Delete
Application.ScreenUpdating = True
End If
End With
'#########
'change Dir
ChDrive "c:\"
ChDir s
'#########
ActiveWorkbook.Save
End Sub