VBA Macro: Change the attached image based on the Cell Value

[arlam720]

Hi There,

I would like to ask for your help on how to set up a marco on below criterica

I have already attached a few image in Column C, But the name is only picture 1, 2, 3 etc.
I would like to set up a macro that can change the Image name based on Column G by select the picture and run Macro

For example > Picture 1 change to angry
> Picture 2 Change to Fun

Cheers,

 

[My Aswer Is This]

Assuming you only have 3 Pictures
And they are now named "Picture 1" and "Picture 2" etc.
And you have the names like Dog Cat Fish in rows 1 to 3 of column "C"

Try this.

Sub Modify_Picture()
Dim i As Long
    For i = 1 To 3
        ActiveSheet.Shapes.Range("Picture " & i).Name = Cells(i, "G").Value
    Next
End Sub

 

[arlam720]

Thanks a lot, My Aswer Is This!!

But is that possible to make a macro that based on Image selection and change the image name at each click.
For example, random
1.select Image at C3, Click run Macro, change name based on G3.
2. select Image at C9, Click run Macro, change name based on G9.
3. select Image at C5, Click run Macro, change name based on G5.

Thanks a lot for your help.

 

[My Aswer Is This]

How did you put these Pictures precisely into a particular cell?

Now your saying it does not matter what the name of the picture is. It now depends on what cell the picture is in.

 

[arlam720]

How did you put these Pictures precisely into a particular cell?

Now your saying it does not matter what the name of the picture is. It now depends on what cell the picture is in.

Thank a lot for your prompt reply.
I have using a Marco to resize (based on the Topleftcell) and make the picture stick and size with the cell when i attached the image.
eg: i put the picture at Cell C2,it will stick at C2.

 

[My Aswer Is This]

So you run a script to put all the images into column "C"

But then you want to go back and click on each image one at a time to assign the image a name.

Why not name the image at the same time when you run the script putting the image in the cell?

Show me your script which puts the image in the cell

 

[arlam720]

So you run a script to put all the images into column "C"

But then you want to go back and click on each image one at a time to assign the image a name.

Why not name the image at the same time when you run the script putting the image in the cell?

Show me your script which puts the image in the cell

Here is my script

Public Sub FitPic()
On Error GoTo NOT_SHAPE
Dim PicWtoHRatio As Single
Dim CellWtoHRatio As Single
With Selection
PicWtoHRatio = .Width / .Height
End With
With Selection.TopLeftCell
CellWtoHRatio = (.Width) / (.RowHeight)
End With
Select Case PicWtoHRatio / CellWtoHRatio
Case Is > 1
With Selection
.Height = .TopLeftCell.RowHeight - 5
.Width = .Height * PicWtoHRatio
.Placement = xlMoveAndSize
End With
Case Else
With Selection
.Height = .TopLeftCell.RowHeight - 5
.Width = .Height * PicWtoHRatio
.Placement = xlMoveAndSize
End With
End Select
With Selection
.Top = (.TopLeftCell.Top + 1)
.Left = (.TopLeftCell.Left + 1)
.Placement = xlMoveAndSize
End With


Exit Sub
NOT_SHAPE:
MsgBox "Select a picture before running this macro."
End Sub

 

[My Aswer Is This]

Try this:

Put the name you want in the active cell before running this script.
Or we can have a InputBox for you to enter name in at beginning of script

See new parts marked in red:

Public Sub FitPic()
On Error GoTo NOT_SHAPE
Dim PicWtoHRatio As Single
Dim CellWtoHRatio As Single
[COLOR=#ff0000]Dim ans As String [/COLOR]'New
[COLOR=#ff0000]ans = ActiveCell.Value 'New[/COLOR]
With Selection
PicWtoHRatio = .Width / .Height
End With
With Selection.TopLeftCell
CellWtoHRatio = (.Width) / (.RowHeight)
End With
Select Case PicWtoHRatio / CellWtoHRatio
Case Is > 1
With Selection
.Height = .TopLeftCell.RowHeight - 5
.Width = .Height * PicWtoHRatio
.Placement = xlMoveAndSize
End With
Case Else
With Selection
.Height = .TopLeftCell.RowHeight - 5
.Width = .Height * PicWtoHRatio
.Placement = xlMoveAndSize
End With
End Select
With Selection
.Top = (.TopLeftCell.Top + 1)
.Left = (.TopLeftCell.Left + 1)
[COLOR=#ff0000].Name = ans ' New part[/COLOR]
.Placement = xlMoveAndSize
End With
Exit Sub
NOT_SHAPE:
MsgBox "Select a picture before running this macro."
End Sub

 

[arlam720]

Thanks a lot!!!!! it's work!!

 

[My Aswer Is This]

Glad I was able to help you. Come back here to Mr. Excel next time you need additional assistance.

Thanks a lot!!!!! it's work!!