Excel macro places images, but they do not appear

问题:

I have been slaving away, trying desperately to piece together a huge macro for my job from what I can find on the internet. The aim is to format reports, ultimately.

This part of the code takes the value from a cell, and finds the respectively named image file in a given folder, then it "inserts" the image into a certain cell. (I know it's not technically inserting it, but still.)

The problem is that other people need to view these reports, but the images do not show when I send the workbook to them. I have no idea how to rectify this and it is such a big deal. am BEGGING YOU, please help me figure out a way to do this so that other employees will be able to see the images! My job may depend on it! :(

Dim pictureNameColumn As String
Dim picturePasteColumn As String
Dim pictureName As String
Dim lastPictureRow As Long
Dim pictureRow As Long
Dim pathForPicture As String
pictureNameColumn = "A"
picturePasteColumn = "B"
pictureRow = 4
lastPictureRow = Cells(Rows.Count, pictureNameColumn).End(xlUp).Row
pathForPicture = "C:\Users\desid\reportimages\" 
Do While (pictureRow <= lastPictureRow)
pictureName = Cells(pictureRow, "A")
If (pictureName <> vbNullString) Then
If (Dir(pathForPicture & pictureName & ".jpg") <> vbNullString) Then
Cells(pictureRow, picturePasteColumn).Select
ActiveSheet.Pictures.Insert(pathForPicture & pictureName & ".jpg").Select
With Selection
.Left = Cells(pictureRow, picturePasteColumn).Left + 30
.Top = Cells(pictureRow, picturePasteColumn).Top + 3
.ShapeRange.LockAspectRatio = msoTrue 
.ShapeRange.Height = 90#
.ShapeRange.Width = 90#
.ShapeRange.Rotation = 0#
End With

回答1:

Instead of inserting picture with ActiveSheet.Pictures.Insert, try embedding it with this method. Please also note that Cells does not accept letters as column names, it requires numbers of columns, so that "A" becomes 1:

Dim repPic as Shape
Dim pictureNameColumn As Long
Dim picturePasteColumn As Long
Dim Lft as Single
Dim Tp as Single
Dim Wdth as Single
Dim Hgth as Single
pictureNameColumn = 1
picturePasteColumn = 2
Lft = Cells(pictureRow, picturePasteColumn).Left + 30
Tp = Cells(pictureRow, picturePasteColumn).Top + 3
Wdth = Cells(pictureRow, picturePasteColumn).Width
Hgth = Cells(pictureRow, picturePasteColumn).Height
Set repPic = Application.ActiveSheet.Shapes.AddPicture(pathForPicture & pictureName & ".jpg", False, True, Lft,Tp,Wdth,Hgth)

This will let you save the pictures in the file itself. You will have to figure out how to work out the size of the picture with wdth and hgth, because with this method you have to specify width and height at the moment of inserting the picture. My suggested solution is in the code, but it might not work for your setup.

Hope this helps, and if it does please mark the answer as accepted. Good luck!

回答2:

If people have to run the macro, then that is where the problem comes from: If (Dir(pathForPicture & pictureName & ".jpg") <> vbNullString) will return False if the filePath can't be accessed. Try finding a public folder to put your pictures in. I don't have a solution to your problem but at least now you know where the problem comes from.