Need help with VBA code to exchange one image for another

Hi all,

Hoping to get a little help with a VBA issue I'm having. I've looked all over the internet finding a lot of code snippets that are close, but nothing that is workable for my needs.

Here are the specifics...

-I have a list of image files with file paths in excel.
-I need a macro that will insert the first picture in the list and name the object "mypic".
-Every time, I run the macro, I want it to replace the old pic with the next pic in the list, callilng it "mypic" and preserving the aspect ratio of each new image, but placing them in the same location in the sheet.

I think I've got the cycling down the list working okay, but deleting and replacing the images is giving me a huge headache and wasting my whole day.

Many thanks in advance for any help and a happy 2018 to everyone!

That's absolutely awesome Kev.

I really appreciate your time with it and will definitely be able to use it.

Many thanks and happy new year.

Hi Kev,

I've just applied your code to my purpose and it works well, but is there a way to specify the image height, and have the width fluid so it keeps the aspect ratio and doesn't distort the image?

Many thanks again.

Yes
- do you want the height to always be the same value? (with width adjusted automatically to maintain aspect ratio)

Hi Kev,

Yes, I'd like the height of each image to match a setting I enter in the VBA code, and the width automatically adjust so as not to skew the image.

Many thanks for your ongoing help Kev. You're great.

Thanks Kev.

That works great.

Only thing is that images are still being skewed where the width of the image is more than the width of my Excel cell.

I've adjusted your code a little (I'll insert other code to handle image cycling later), but my end goal is to have each image appear within the confines of the Excel cell, so if the width is more than the width I have, it should shrink the image width but preserve the aspect ratio by shrinking the height too. The same holds true if the height is more than my cell's height.

I also added a bit of code at the bottom which was intended to centre the image within my cell area, but it isn't working for some reason.

Any chance I can trouble you for a bit more help?

Many thanks Kev.

Const ImageCellRef = "AD25"
Const CurrentImage = "MyPic"
Const ImageSheet = "YTShow"
Const ListSheet = "YTShow"
Sub show_Button11_Click()

Dim ImageName As String, ImagePath As String
Dim sh As Worksheet: Set sh = Sheets(ImageSheet)
Dim ws As Worksheet: Set ws = Sheets(ListSheet)

'delete current image
sh.Activate
On Error Resume Next
sh.Shapes(CurrentImage).Delete
On Error GoTo 0
sh.Range(ImageCellRef).Select

'next image (insert my image cycling code here)
ImagePath = Range("AF66")

'insert image
On Error Resume Next
sh.Pictures.Insert(ImagePath).Select
With Selection
.Name = "MyPic"
.ShapeRange.LockAspectRatio = msoTrue
.ShapeRange.Height = ActiveCell.Height
End With
'Rng.Value = "used"
sh.Range("AD25").Select

'============================================

With Range("AD25")
MyPic.Left = .Left + ((.Width - MyPic.Width) / 2)
MyPic.Top = .Top + ((.Height - MyPic.Height) / 2)
End With


End Sub

That's awesome Kev.

I'll try to implement tomorrow and see how it looks.

I really, really, really appreciate your time and help.

Hi Kev,

I just used your code and it works perfectly.

Thanks so much for your help.

Your support has been amazing and very appreciated.