VBA help to move all images from a cell, not folder?

[User_Renee]

Hi all, I have a sheet with 8 images in a column F2:F9. Each cell in F2:F9 has one image with corresponding details. I'd like to move all these images to the square box in the 8 card templates I've made on Excel. The square box example can be seen from cell D8:E12.I was referring to this thread on StackOverflow for ideas to move the images into these specific cells but I was unable to pinpoint the specific locations I've designated for the images on these card templates.

May I kindly ask for help from the VBA community on this? Thank you in advance for scratching a huge problem I'm stuck on figuring over the past weekend.

For any extra information, I'm using the latest Microsoft 365 version for Excel.
29851

[User_Renee]

Hi there, just to add, here's an example of the Macro I recorded to achieve this:

Sub Move_images()'
' Move_images Macro
'


'
ActiveSheet.Shapes.Range(Array("image18.png")).Select
Selection.Copy
Sheets("Sheet1").Select
Range("D8").Select
ActiveSheet.Paste
Selection.ShapeRange.ScaleWidth 0.63, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.48, msoFalse, msoScaleFromTopLeft
Sheets("DATABASE").Select
ActiveSheet.Shapes.Range(Array("image25.png")).Select
Selection.Copy
Sheets("Sheet1").Select
Range("L8").Select
ActiveSheet.Paste
Selection.ShapeRange.ScaleWidth 0.63, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.47, msoFalse, msoScaleFromTopLeft
Sheets("DATABASE").Select
ActiveSheet.Shapes.Range(Array("image8.jpg")).Select
Selection.Copy
Sheets("Sheet1").Select
Range("T8").Select
ActiveSheet.Paste
Selection.ShapeRange.ScaleWidth 0.645, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.48, msoFalse, msoScaleFromTopLeft
Sheets("DATABASE").Select
ActiveWindow.SmallScroll Down:=1
ActiveSheet.Shapes.Range(Array("image21.png")).Select
Selection.Copy
Sheets("Sheet1").Select
Range("AB8").Select
ActiveSheet.Paste
Selection.ShapeRange.ScaleWidth 0.64, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.475, msoFalse, msoScaleFromTopLeft
Sheets("DATABASE").Select
ActiveWindow.SmallScroll Down:=1
ActiveSheet.Shapes.Range(Array("image22.png")).Select
Selection.Copy
Sheets("Sheet1").Select
Range("D30").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=11
Selection.ShapeRange.ScaleWidth 0.635, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.475, msoFalse, msoScaleFromTopLeft
Sheets("DATABASE").Select
ActiveWindow.SmallScroll Down:=2
ActiveSheet.Shapes.Range(Array("image23.png")).Select
Selection.Copy
Sheets("Sheet1").Select
Range("L30").Select
ActiveSheet.Paste
Selection.ShapeRange.ScaleWidth 0.6331658291, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.4773869347, msoFalse, msoScaleFromTopLeft
Sheets("DATABASE").Select
ActiveSheet.Shapes.Range(Array("image16.jpg")).Select
Selection.Copy
Sheets("Sheet1").Select
Range("T30").Select
ActiveSheet.Paste
Selection.ShapeRange.ScaleWidth 0.63, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.495, msoFalse, msoScaleFromTopLeft
Sheets("DATABASE").Select
ActiveWindow.SmallScroll Down:=1
ActiveSheet.Shapes.Range(Array("image19.png")).Select
Selection.Copy
Sheets("Sheet1").Select
Range("AB30").Select
ActiveSheet.Paste
Selection.ShapeRange.ScaleWidth 0.62, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.485, msoFalse, msoScaleFromTopLeft
ActiveWindow.SmallScroll Down:=-11
End Sub
Hope it helps specify what I'm struggling to understand and build upon.

[georgiboy]

Perhaps the attached will help?

[User_Renee]

Perhaps the attached will help?

Thank you so so much for providing me ideas on how to manually move the items over. I'm also learning how to iterate through items under a column so studying from your VBA code helps so much! Really appreciate you!

[jolivanes]

manually?????
Name your pictures as the name to the right, put a placeholder (rectangle without lines maybe) where the pictures need to go and a very short macro will do the deed for you.

[User_Renee]

Based on georgiboy's demonstration, I tried the name manager method and assigned the VBA actions to move the images tied to the name fields. Your suggestion on putting a placeholder helps more because I was navigating cell by cell and scratching my head hard to adjust the image dimensions. Thank you too!

[jolivanes]

I don't have time at the moment but this is how I fill a rectangle with a picture selected from a folder.

Sub Maybe_Rect1_Only()
Dim fNameAndPath As Variant
Dim img As Picture
fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
If fNameAndPath = False Then Exit Sub
ActiveSheet.Shapes("Rectangle 1").Fill.UserPicture (fNameAndPath)
End Sub
I'll have a look tomorrow and see what I can come up with.

[User_Renee]

Thanks for helping me with your limited time. Your method does look easier to pre-shape images and ngl I am mindblown to learn that you can pre-shape/pre-position mapping things via excel shapes. I'm starting to love vba a bit more as I'm discovering more of it. I'm usually a python programmer, that's why I'm struggling to learn vba, the logic differs quite a bit.


I don't have time at the moment but this is how I fill a rectangle with a picture selected from a folder.

Sub Maybe_Rect1_Only()
Dim fNameAndPath As Variant
Dim img As Picture
fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
If fNameAndPath = False Then Exit Sub
ActiveSheet.Shapes("Rectangle 1").Fill.UserPicture (fNameAndPath)
End Sub
I'll have a look tomorrow and see what I can come up with.

[jolivanes]

As promised.
The attached is not a replacement for georgiboy's suggestion, just an alternative and as you try it you might see it's shortcomings also.
I do not know if the sometimes errors when working with pictures is excel version related or not but quite a few questions on the web about it.

[georgiboy]

I have had issues in the past when saving and moving pictures where there is a delay using the clipboard etc...

So where we have:

myPic.Copy
DoEvents
DoEvents

The double DoEvents can still cause the errors from time to time with the copy/ paste' so I would lean towards error handling for it as below:

Do
On Error Resume Next
myPic.Copy
If Err.Number = 0 Then Exit Do
DoEvents
Loop
On Error GoTo 0


Do
On Error Resume Next
tempChartObj.Chart.Paste
If Err.Number = 0 Then Exit Do
DoEvents
Loop
On Error GoTo 0

It's not ideal but I have found it to be more reliable than the double DoEvents.

@jolivanes
I see the note about the merged cells - I completely agree however I do use them for instances like this one. I will always avoid them on data or anything for that matter that could be analysed at a later date. When building something that is just to be printed or is just for looks then I will use merging as I suppose this is what I deem it is for. It makes sizing the image in this instance easier to code.


Happy coding people,

George

[jolivanes]

Nice one George. I'll change it in some of my files where I have the DoEvents implemented. It is no problem for me because I know it happens sometimes and why.
You know that at times someone will come back with a "It doesn't work!"
As far as merged cells is concerned, that is true also of course but it is just that I try to not get into a habit of having to have to choose between "is it going to be a possible problem in the future" or "is it OK now". No biggie though.
Thanks again George and as you said, happy days are ahead we hope.

[snb]

Avoid merged cells anytime.
See the attachment.

[jolivanes]

Obviously I do agree with "Avoid merged cells anytime." but if someone insists on it, this would be way around it for this case.
At the beginning and at the end.

Cells(j, i).Resize(6, 2).MergeCells = Cells(j, i).Resize(6, 2).MergeCells = False

[snb]

As you can see there is no justification to use merged cells, not even for visual purposes.
The combination with VBA is nefast.

[georgiboy]

As you can see there is no justification to use merged cells, not even for visual purposes.
The combination with VBA is nefast.

I based my example file on the TS's image, if users wish to use them then I have no problem as long as they are not in the data sets. I agree they can be aggravating but they have their purpose.

I am not here to say what people should and should not do - I am here to help them with their issues and offer concise help.

[jolivanes]

Re: "nefast"
I'm glad I have google.