I'm looking to add in the lines to lock the inserted image ratio and specify a width of 5 inches. I'm not real sure how to go about this. Any help would be greatly appreciated.
Sub inserts a pic in a specified cell range if the cell contents equal the pic file name. All of the pics aren't the same size, so I would like to resize them with a locked image ratio to prevent distorting them. (5inch width, height to be determined by image ratio)
************************************************************************
Sub InsertPicComment()
Const sPath As String = "C:\Username\Profile Book\Drawing Images\8200\"
Dim cell As Range
Dim **** As String
Dim oCmt As Comment
For Each cell In Range("A1780:A1884")
With cell
If Len(.Text) Then
**** = sPath & .Value & ".jpg"
If Len(Dir(****)) Then
If .Comment Is Nothing Then
Set oCmt = .AddComment
Else
Set oCmt = .Comment
End If
With oCmt
.Text Text:="Contact Username to report errors"
.Shape.Fill.UserPicture ****
.Visible = False
End With
Else
MsgBox "Pic " & **** & " not found for cell " & .Address
End If
End If
End With
Next cell
End Sub
Sub inserts a pic in a specified cell range if the cell contents equal the pic file name. All of the pics aren't the same size, so I would like to resize them with a locked image ratio to prevent distorting them. (5inch width, height to be determined by image ratio)
************************************************************************
Sub InsertPicComment()
Const sPath As String = "C:\Username\Profile Book\Drawing Images\8200\"
Dim cell As Range
Dim **** As String
Dim oCmt As Comment
For Each cell In Range("A1780:A1884")
With cell
If Len(.Text) Then
**** = sPath & .Value & ".jpg"
If Len(Dir(****)) Then
If .Comment Is Nothing Then
Set oCmt = .AddComment
Else
Set oCmt = .Comment
End If
With oCmt
.Text Text:="Contact Username to report errors"
.Shape.Fill.UserPicture ****
.Visible = False
End With
Else
MsgBox "Pic " & **** & " not found for cell " & .Address
End If
End If
End With
Next cell
End Sub