Inserting Pictures in Excel

[sanai79]

Hi. I'm having a little trouble using a macro to insert pictures into worksheet. This first macro I'm using inserts a picture as a comment.

Dim i As Integer
Dim bcontinue As Boolean
Dim rCurrent As Object

Sub AddPicturetoCol()
bcontinue = True
i = 2

While bcontinue
Set rCurrent = Worksheets("Sheet1").Cells(i, 58)
If IsEmpty(rCurrent) Then
bcontinue = False
Else
AddPictureToComment
i = i + 1
End If
Wend
End Sub

Sub AddPictureToComment()
Dim shp As Comment

If Not rCurrent.Comment Is Nothing Then
rCurrent.Comment.Delete
End If

If rCurrent.Text <> "" Then
Set shp = rCurrent.AddComment("")
shp.Shape.Fill.UserPicture "H:\Pictures\" + rCurrent.Text
shp.Shape.LockAspectRatio = msoTrue
shp.Shape.Height = 300
End If

End Sub

I know the macro is rough around the edges (just started writing vba). My problem is the pictures are differnet sizes and when I run the macro, it does not preserve the original aspect ratio of the picture (it seems it creates the comment box, inserts picture(stretching it to fit the comment box), THEN it locks aspect ratio, and lastly resizes the height to 300.

Also, I'm having a similar problem with inserting pictures into regular cell boxes. I got this macro from another site (don't remember where):

Sub testme01()
Dim myPict As Picture
Dim curWks As Worksheet
Dim myRng As Range
Dim myCell As Range
Dim myPictName As Variant

Set curWks = Sheets("Pictures")

curWks.Pictures.Delete

With curWks
Set myRng = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
End With

For Each myCell In myRng.Cells
If Trim(myCell.Value) = "" Then
'do nothing
ElseIf Dir(CStr(myCell.Value)) = "" Then
'picture not there!
MsgBox myCell.Value & " Doesn't exist!"
Else
With myCell.Offset(0, 3) '3 columns to the right of A (D)
Set myPict = myCell.Parent.Pictures.Insert(myCell.Value)
myPict.Top = .Top
myPict.Width = .Width
myPict.Height = .Height
myPict.Left = .Left
myPict.Placement = xlMoveAndSize
End With
End If
Next myCell

End Sub

Again, this resizes the picture to fit perfectly into the box, which I don't want. I want to resize it to fit with the height, but not the width, as the pictures are all different sizes. It would also be great is it centers the picture. Only other solution I can think of is to use a photo program to resize the pictures before running the macro. Any help will be appreciated.

Thanks.