Help with code to grab image

[realhiphop]

I'm creating a dashboard similar to the FIFA dashboard on this website. I have a list of teams and images. I'm getting a compile error. I changed some of the names from the FIFA code, but double checked the references and can't figure out what's wrong.

OptionExplicit



Sub Teamdrop()

Dim Pic_sheet As Worksheet

Dim Dash_sheet As Worksheet

Dim imgLogo As Shape

Dim nameLogo AsString



  Application.ScreenUpdating = False

  Application.EnableEvents = False



  Set Pic_sheet = ThisWorkbook.Worksheets(Team.Name)

  Set Dash_sheet = ThisWorkbook.Worksheets(Dashboard.Name)

  Dash_sheet.Activate



  nameFlag = Range("TeamShort").Value


  'Select the logo

  For Each imgLogo In Dashboard.Shapes

    If imgLogo.Name = nameLogo Then

        ActiveSheet.Shapes.Range(Array(nameLogo)).Delete

        Exit For

    End If

  Next



  Pic_sheet.Activate

  Pic_sheet.Shapes(nameLogo).Copy


  'Paste the logo with name as in "Logo" cell


  Dash_sheet.Activate

  Range("LogoPos").Select

  ActiveSheet.Paste

  ActiveSheet.Shapes.Range(Array(nameLogo)).Select

   

  'Position the logo in center of cell

  Selection.ShapeRange.IncrementLeft 12

  Selection.ShapeRange.IncrementTop 4.5


  Application.ScreenUpdating = True

  Application.EnableEvents = True

Range("B4").Select

EndSub

The error seems to be on the Team.Name line. Not sure why.

Thanks in advance!

 

[NARAYANK991]

Hi ,

The Name property is valid only for an object or a control.

If my guess is correct , you have tabs named Team and Dashboard ; in such as case , the correct syntax for the two lines of code would be :

Set Pic_sheet = ThisWorkbook.Worksheets("Team")

Set Dash_sheet = ThisWorkbook.Worksheets("Dashboard")

Narayan

 

[realhiphop]

I only have a tab named Dashboard. I don't have a tab named Team. Why is the code working correctly on the FIFA spreadsheet? I see a tab named Dashboard on it, but not one named team.

 

[NARAYANK991]

Hi ,

The FIFA workbook does have two tabs named Dashboard and Team ; however , these are the codenames of these tabs , not the sheet names.

You will have to go to the VBA editor screen to access these names from the panel on the left hand side. Click on the sheet name , and press the F4 key to bring up the Properties window ; the first property labelled (Name) needs to be changed.

Narayan

 

[realhiphop]

Thanks Narayan. It's almost working. The next issue I'm having is on this line:

Pic_sheet.Shapes(nameLogo).Copy

Also, how did they get all of the flags centered, and fit perfectly within the cell on the FIFA spreadsheet? I didn't see a macro on the spreadsheet to do that.

 

[NARAYANK991]

Hi ,

I see some issues with your variables.

I assume you have created the named ranges TeamShort and LogoPos.

I see that the variable nameLogo has been declared but not assigned a value ; the variable nameFlag as been assigned a value but has not been declared.

Narayan

 

[realhiphop]

All of my named ranges are correct. In addition, I fixed that error. Here's my current code:

Option Explicit

Sub Teamdrop()
Dim Pic_sheet As Worksheet
Dim Dash_sheet As Worksheet
Dim imgLogo As Shape
Dim nameLogo As String

  Application.ScreenUpdating = False
  Application.EnableEvents = False

  Set Pic_sheet = ThisWorkbook.Worksheets(Team.Name)
  Set Dash_sheet = ThisWorkbook.Worksheets(Dashboard.Name)
  Dash_sheet.Activate

  nameLogo = Range("TeamShort").Value
  'Select the logo
  For Each imgLogo In Dashboard.Shapes
     If imgLogo.Name = nameLogo Then
        ActiveSheet.Shapes.Range(Array(nameLogo)).Delete
        Exit For
     End If
  Next

  Pic_sheet.Activate
  Pic_sheet.Shapes(nameLogo).Copy
  'Paste the logo with name as in "Logo" cell
  Dash_sheet.Activate
  Range("LogoPos").Select
  ActiveSheet.Paste
  ActiveSheet.Shapes.Range(Array(nameLogo)).Select
  
  'Position the logo in center of cell
  Selection.ShapeRange.IncrementLeft 12
  Selection.ShapeRange.IncrementTop 4.5
  Application.ScreenUpdating = True
  Application.EnableEvents = True
Range("B4").Select
End Sub

 

[NARAYANK991]

Hi ,

So what issues are still to be resolved ?

As far as the flags are concerned , select one flag , and then do CTRL A to select all the flags. Click on Format in the Picture Tools menu , and set the common height and width.

Next , select the rows and column and set their height and width appropriately.

Next , select the first flag and position it correctly in its cell ; do the same for the last flag. Now select all the flags and select Distribute Vertically.

Narayan

 

[realhiphop]

Thanks! I'm getting a runtime error that says "The item with the specified name wasn't found". The debug is highlighting Pic_sheet.Shapes(nameLogo).Copy

 

[Marc L]

Hi !

It seems shape does not exist !

You may check with this function :​

Function ExistShape(S, Optional Ws As Worksheet) As Boolean
         If Ws Is Nothing Then Set Ws = ActiveSheet
         On Error Resume Next
         ExistShape = IsObject(Ws.Shapes(S))
End Function

Do you like it ? So thanks to click on bottom right Like !
​

 

[realhiphop]

Is there another way to do this? I copied the exact code from the FIFA workbook and just tweaked for my name references.

 

[NARAYANK991]

Hi ,

What does the variable nameLogo contain ?

It should contain the short form name of the Team.

On the Team tab , is there a flag with this short form name ?

If you can upload your workbook , your problem would have been resolved a while back , since all this back and forth is just wasting time.

Narayan

 

[realhiphop]

Here it is.

 

[Chihiro]

Ok, so you need to match name of the inserted image to Team short name.

Ex. Baltimore Orioles image should be named BAL etc.

See attached.

 

[realhiphop]

Chihiro- Thanks so much for the fix. Didn't realize it was going to be that simple!

Is there any way to delete the prior logo in cell "C5" when choosing a new team name and pasting that team logo in "C5". Right now, it looks like the logo is simply pasted directly over the prior logo.

 

[Chihiro]

Change below portion.

  For Each imgLogo In Dashboard.Shapes
    If imgLogo.Name = nameLogo Then
        ActiveSheet.Shapes.Range(Array(nameLogo)).Delete
        Exit For
    End If
  Next

To something like.

  For Each imgLogo In Dashboard.Shapes
    If imgLogo.Type = 13 Then
        imgLogo.Delete
        Exit For
    End If
  Next

This is assuming that there is no other embedded images on the sheet. To set it up, before you run the code remove all existing images from "Dashboard". Otherwise I'd stick with original code.