Sub InsertPhotoEx(ByVal PicturePath As String, ByRef cell As Range)
On Error Resume Next
dh = 2 ' îòñòóï îò êðà¸â ÿ÷åéêè
Const k = 26.46
If F.CheckBox_Comments Then ' êàðòèíêè â ïðèìå÷àíèÿ
cell.Comment.Delete
Set pic = LoadPicture(PicturePath)
With cell.AddComment.Shape
w = pic.Width / k: h = pic.Height / k
picRatio = w / h
settingRatio = F.SpinButton_WComm / F.SpinButton_Hcomm
If picRatio >= settingRatio Then ' êàðòèíêà øèðå, ÷åì ïðèìå÷àíèå
h = h / w * F.SpinButton_WComm
w = F.SpinButton_WComm
Else ' êàðòèêà óæå, ÷åì ïðèìå÷àíèå
w = w / h * F.SpinButton_Hcomm
h = F.SpinButton_Hcomm
End If
.Fill.UserPicture PicturePath ' âñòàâëÿåì êàðòèíêó
.Width = w
.Height = h
End With
Exit Sub
End If
On Error Resume Next: Dim sha As Shape
Set sha = cell.Worksheet.Shapes.AddPicture(PicturePath, True, True, cell.Left + dh, cell.Top + dh, cell.Width - 2 * dh, cell.Height - 2 * dh)
If F.CheckBox_LockAspectRatio Then
sha.ScaleWidth 1, msoTrue
sha.ScaleHeight 1, msoTrue
End If
With sha
.LockAspectRatio = msoTrue
.Top = cell.Top + dh
w = .Width: h = .Height: .Height = cell.Height - 2 * dh
.Width = w * .Height / h
.Left = cell.Left + cell.Width / 2 - .Width / 2
End With
If F.CheckBox_AddHyperlinks Then cell.Worksheet.Hyperlinks.Add sha, PicturePath, "", _
"Ùåëêíèòå äëÿ ïðîñìîòðà" & vbLf & "îðèãèíàëüíîãî èçîáðàæåíèÿ"
End Sub
