Inserting Pictures in Excel

sanai79

New Member
Joined
Oct 11, 2006
Messages
1
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.
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

Forum statistics

Threads
1,137,337
Messages
5,680,904
Members
419,939
Latest member
AJWildOne

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top