Consulting

Results 1 to 16 of 16

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

  1. #1

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

    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.
    imagex.jpg

  2. #2
    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.

  3. #3
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    Perhaps the attached will help?
    Attached Files Attached Files
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

  4. #4

    Thank you so much for giving me a head start on what to do!!!

    Quote Originally Posted by georgiboy View Post
    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!

  5. #5
    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.


  6. #6
    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!

  7. #7
    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.

  8. #8
    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.

    Quote Originally Posted by jolivanes View Post
    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.

  9. #9
    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.
    Attached Files Attached Files

  10. #10
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    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
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

  11. #11
    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.

  12. #12
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    Avoid merged cells anytime.
    See the attachment.
    Attached Files Attached Files

  13. #13
    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

  14. #14
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    As you can see there is no justification to use merged cells, not even for visual purposes.
    The combination with VBA is nefast.

  15. #15
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    Quote Originally Posted by snb View Post
    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.
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •