Aligning Pictures to a cell

[Max]

Hello All,
I am in need of help with changing code.
This file is a league table (log).
At present I have code written by Bernie Deitrick. This code changes the
position of the relevant team badges (picture) as the teams name moves up or
down the league table, so the picture will move up or down with the team name.
I have copied the same code into a file for a Rugby table, but I have two
pictures linked for each team, 1 for the team badge and the other for the
country flag.

Here is the code that changed the badge.

Option Explicit

Private Sub Worksheet_Calculate()
Dim oPic As Picture
Dim rCell As Range
Me.Pictures.Visible = True
For Each rCell In Range("B4:B17").Cells
With rCell
Set oPic = Me.Pictures(Replace(.Text, " ", ""))
oPic.Visible = True
oPic.Top = .Top + .Height / 1.4 - oPic.Height / 1.4
oPic.Left = .Offset(0, 1).Left + .Offset(0, 1).Width / 2 -
oPic.Width / 2
End With
Next rCell
End Sub

How can this be adapted to change two pictures for each respective team each
time it moves up or down the league table?

Thank you for your help.

Max

 

[Max]

Hello All,
Sorry I did not mention that the team badge and the country flag will be in
seperate cells.
Team name cell A1
Team badge cell B1
Country flag cell C1

Thank you for your help.

Max

 

[Joel]

Let me explain how your code works. Look at this line of code

Set oPic = Me.Pictures(Replace(.Text, " ", ""))

It sets the oPic to match the name of the badge. the Replace is simply
removing a blank from the badge name. What you code does is gets the badge
name in column B and the sets the picture that matches the bade name to
"oPic". the puts the picture in column C (by offset(0,1) moves over one
column from B) and places the picture into the cell.

Lets say you make a new picture for each team with the name of the new
pictures the Badge name with the number 2 at the end

Set oPic = Me.Pictures(Replace(.Text, " ", ""))
Set oPic2 = Me.Pictures(Replace(.Text & "2", " ", ""))

Now you have two pictures


the final code will lokk like this putting the 2nd picture in column D

Option Explicit

Private Sub Worksheet_Calculate()
Dim oPic As Picture
Dim rCell As Range
Me.Pictures.Visible = True
For Each rCell In Range("B4:B17").Cells
With rCell
Set oPic = Me.Pictures(Replace(.Text, " ", ""))
oPic.Visible = True
oPic.Top = .Top + .Height / 1.4 - oPic.Height / 1.4
oPic.Left = .Offset(0, 1).Left + .Offset(0, 1).Width / 2 -
oPic.Width / 2
Set oPic2 = Me.Pictures(Replace(.Text & "2", " ", ""))
oPic2.Visible = True
oPic2.Top = .Top + .Height / 1.4 - oPic2.Height / 1.4
oPic2.Left = .Offset(0, 2).Left + .Offset(0, 2).Width / 2 -
oPic2.Width / 2
End With
Next rCell
End Sub

 

[Max]

Hello Joel,
Thank you for your explanation. I have asked for help many times in the past
on this forum, this is the first time I have received an explanation of value
like yours. This is what I call helping in excellence. Thank you.

Please excuse my ignorance. Should there be an expression defining (Dim) for
Pic2?

Running the code gives a "Run-time error '1004': The item with the specified
name wasn't found."

I have tried to enter a line "Dim oPic2 As Picture" below the existing "Dim
oPic As Picture" and still the same error message.

Thank you again for your help, it is much appreciated.

Max

 

[Max]

Hello Joel,
It works well with the "Dim oPic2 As Picture" in place under the "Dim oPic
As Picture".

I made a mistake naming one of the flags.

Thank you again.

Max