Hi guys, I need your help once again!
I have a macro which adds pictures onto a worksheet but it is running into two problems.
Firstly, on my version of Excel (2013) the pictures are resized correctly and the aspect lock is removed. However, on my colleagues version of excel (2010) it seems to not be disabling the aspect lock. Is there a different command for it in 2010? My code is shown below:
img.ShapeRange.LockAspectRatio = msoFalse 'Disables the lock on the aspect ratio so that the picture can be freely resized
img.Width = 227 'Fits the picture to the width of the cell
img.Height = 150
Secondly, I seem to be having some issues once the picture is inserted. If I look at it on my laptop then the pictures appear but when the file is transferred to another laptop it does not seem to be taking the pictures with it? (I get an error message to say that the link is broken). How do I put the pictures in as pictures rather than just links to the pictures? My code for adding the pictures is shown below:
For picloop = 4 To 46 Step 2
'If column "B" is blank then the cell address for the picture insertion below is selected here
If Sheets("Pictures").Cells(picloop, "B").Value = "" And Not Sheets("Pictures").Cells(picloop + 1, "B").Value Like "ADIPS*" Then
'Picture missing is inserted so that it is visually obvious that a picture has been lost
Sheets("Pictures").Cells(picloop, "B").Value = "Picture Missing"
figuredetails = Sheets("Pictures").Cells(picloop + 1, "B").Value 'Takes the figure value to put on the report
picrow = picloop 'Row where picture is to be inserted
piccolumn = 2 'Column where picture is to be inserted "B" = 2
picloop = 46 'Jumps out of the loop
'If column "B" is occupied but column "C" on the same row is empty then this cell is selected
ElseIf Sheets("Pictures").Cells(picloop, "B").Value = "" And Sheets("Pictures").Cells(picloop + 1, "B").Value Like "ADIPS*" Then
picloop = picloop + 4
ElseIf Sheets("Pictures").Cells(picloop, "B").Value <> "" And Sheets("Pictures").Cells(picloop, "C").Value = "" And Not Sheets("Pictures").Cells(picloop, "B").Value Like "ADIPS*" Then
Sheets("Pictures").Cells(picloop, "C").Value = "Picture Missing"
figuredetails = Sheets("Pictures").Cells(picloop + 1, "C").Value
picrow = picloop
piccolumn = 3
picloop = 46
ElseIf Sheets("Pictures").Cells(picloop, "B").Value <> "" And Sheets("Pictures").Cells(picloop, "C").Value = "" And Sheets("Pictures").Cells(picloop, "B").Value Like "ADIPS*" Then
picloop = picloop + 4
End If
Next
Dim img As Object
Set img = Sheets("Pictures").Pictures.Insert(.SelectedItems(1))
'Position Image
img.Left = Sheets("Pictures").Cells(picrow, piccolumn).Left 'Sets the picture column as the variable selected above
img.Top = Sheets("Pictures").Cells(picrow, piccolumn).Top 'Sets the picture row as the variable selected above
img.ShapeRange.IncrementLeft 5 'Shuffles the picture into the centre of the cell
' img.Name = Sheets("Pictures").Cells(picrow + 1, piccolumn).Value
You guys have been mighty helpful in the past and I need some more now because I have been scratching my head for ages over this!
Thanks
Tom
Bookmarks