multiple instances of images?

S

sumhungl0

Board Regular
Joined
Jan 1, 2014
Messages
119
im working on a parking visual layout for an airfield. on sheet1 I have an image of the airfield and I would like to show little plane icons over it to indicate what plane is in what parking spot. I would also like to change the textbox value of each instance of the plane icon to show the plane number. I also have several versions of the plane icon that are colored different. example, red plane is for a broken plane and green is for a good plane. I figured I would set up a sheet2 that has plane numbers, current parking location and its condition. that way I could use the info in that table for vba/macro to use to place the appropriate image and the text plane number. not sure how I should even start this project. so I will just start asking questions? 1) can I have multiple instances of an image in excel and how would I do that? 2) would multiple instances of an image allow me to identify them and label them with the textbox of the instance? something like Sheet1.Shapes("instance1").TextFrame.Characters.Text = sheet2.someCell. 3)I tried using a sample workbook with a form instance for each plane but the form would not allow me to use plane icon images with transparent backgrounds. so it looked like hell, picture block frames all over the place and blocking the airfield image in the background. is there a way to make an image in a form keep its transparent background? ive been googlen this all day and haven't really come up with anything useful, so here I am. can someone help me get this figured out? thanks in advance.
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Sort by date Sort by votes
To answer your question, no there cannot be multiple instances of a Shape object.
But you could have a custom object with a shape as one of its properties. You could create that object's shape by copying your airplane drawings from your template sheet.
 
Upvote 0
after reading into this a bit more. i can do a sheet1.shapes.addshape and set it to the image i need from sheet2. I will need to set a count of all parking spots (with planes in them) listed in sheet2.range("Location"). that will give me the number of shapes/images I need to display on Sheet1. then "For Each" location/parking spot with a plane, check for the plane's status code in sheet2.range("Status") to select which image to use. green for good, red for broke, ext... still need help setting up the vba for this, would i use "For Each" to set up a count of images/shapes needed? then maybe "Case" to select the image to use? how would i set the variable for each?
 
Last edited:
Upvote 0
As you put the shapes on Sheet1, add them to a collection (remove them if you eliminate the shape).
Code like this will loop through all the shapes.
Code: 
Dim onePlane As Shape

For Each onePlane in myCollection
' code
Next onePlane

A slicker approach would be to make two custom classes clsPlane and clsPlanes so that information could be attached as properties of each plane.
 
Upvote 0
ok, I understand what you suggest about two custom classes. but I do not know how to set that up. I can copy the shapes from sheet2 to paste on sheet1 and name them. how do I set this up like you suggest and then set the properties?
 
Upvote 0
ok lets step through this. how do I set up the above "For Each"? im not doing it by "onePlane", I will be doing it by parking spot. planes come and go, all I need to show is parking spots with planes in them. so how do I set up a "For Each" looking at Sheet2.Range("Location") for any parking spot with a plane, that matches any current airfield spots listed in Sheet2.Range("Position")?
 
Upvote 0
i can do this with a huge if statement. how can i set variables instead? sheet2 col A has plane number id, col b has parking spot, col c has status. i can use If to figure out what status each plane has(col c) and select the shape/image to copy(green for good, red for broken). i can use If to look at col B to see what spot the plane is parked in and then select the range/cell for that shape/image to be pasted into. so how would i set variables in the vba code to be able to use later in the code when required to paste the shape/image?
 
Upvote 0
This sounds like a perfect use for custom objects.
You mentioned two objects, a ParkingSpot and a Plane
What might be properties of a Plane? Type (e.g. "Boeing747") Callsign (e.g."United123"), Filled, Working, ...., Location, Shape(the shape that is that particular plane) ?
What might be properties of a ParkingSpot? OccupiedBy (a Plane object), LocationX, LocationY, Gate#, ...., Shape ?

Note that there can be many ParkingSpots and many Planes. (Just as there can be many Sheets and many Cells)
 
Upvote 0
mikerickson said:
This sounds like a perfect use for custom objects.
You mentioned two objects, a ParkingSpot and a Plane
What might be properties of a Plane? Type (e.g. "Boeing747") Callsign (e.g."United123"), Filled, Working, ...., Location, Shape(the shape that is that particular plane) ?
What might be properties of a ParkingSpot? OccupiedBy (a Plane object), LocationX, LocationY, Gate#, ...., Shape ?

Note that there can be many ParkingSpots and many Planes. (Just as there can be many Sheets and many Cells)
Click to expand...
I am not concerned with types of planes, just whether they are good or broke. and then where they are located/parking spot. I don't know if I want to go as far as custom objects yet. partly because I don't know enough about it and im having a hard enough time with simple coding on this. basically first thing I need to find out is the planes status, good or broken or partly broke. that will tell me what shape/image to copy from sheet2. green plane shape for good, red for broke, ect... after that I can go to the second part of this and paste the shape/image on sheet1 over top of the background image of the airfield so that it shows up in its position. here is what I came up with so far just trying to get one plane positioned. and it is working. I just don't know how to expand this code to multiple planes and spots.
Code: 
Dim spot As Shape, i As Integer
Dim status As String
Dim txt As String
For i = 1 To 20
 
If Sheet2.Range("b" & i) <> "" Then
    If Sheet2.Range("b" & i).Offset(, 1).Value = "Good" Then 'good plane so copy green shape from sheet2
    Sheet2.Shapes("Green").Copy
        If Sheet2.Range("b" & i).Value = "1" Then 'found plane in spot 1
            ActiveSheet.Range("y37").Select
            ActiveSheet.Paste
            txt = Sheet2.Range("b" & i).Offset(, -1).Value
            With Selection
            .Name = txt
            '.LockAspectRatio = msoTrue ' didnt work here for some reason
            '.Width = 315
            End With
            Sheet1.Shapes(txt).TextFrame.Characters.Text = txt
            Sheet1.Shapes(txt).TextFrame.HorizontalAlignment = xlHAlignCenter
            Sheet1.Shapes(txt).TextFrame.VerticalAlignment = xlVAlignCenter
            Sheet1.Shapes(txt).LockAspectRatio = msoFalse
            Sheet1.Shapes(txt).Width = 70
            Sheet1.Shapes(txt).Height = 65
            Sheet1.Shapes(txt).Left = 460
        End If
    End If
End If
Next i
 
Upvote 0
ok I have very bulky code, but it is working. can anyone look at this and let me know if there is a better way of coding this? thank you.
Code: 
Sub Ref_Click()
'set active sheet before running code
If ActiveSheet.Name <> "Ramp" Then
ThisWorkbook.Sheets("Ramp").Select
End If
Dim Shp As Shape
'delete current shapes except background and refresh button
For Each Shp In ActiveSheet.Shapes
    If Shp.Name <> "Picture 1" And Shp.Name <> "Ref" Then Shp.Delete
Next Shp
Dim i As Integer
Dim status As String
Dim txt As String
Dim h As Long, w As Long
h = 65
w = 70
i = 2
For i = 1 To 20
 
If Sheet2.Range("b" & i) <> "" Then
    'select correct color shape
    If Sheet2.Range("b" & i).Offset(, 1).Value = "GOOD" Then 'if good
    Sheet2.Shapes("Green").Copy 'copy green shape
    GoTo position
    ElseIf Sheet2.Range("b" & i).Offset(, 1).Value = "PARTIAL" Then 'if partial good
    Sheet2.Shapes("Yellow").Copy 'copy yellow shape
    GoTo position
    ElseIf Sheet2.Range("b" & i).Offset(, 1).Value = "BROKE" Then 'if not good
    Sheet2.Shapes("Red").Copy 'copy red shape
    GoTo position
    ElseIf Sheet2.Range("b" & i).Offset(, 1).Value = "TRANS" Then  'if trans
    Sheet2.Shapes("Brown").Copy 'copy brown shape

position:        'figure out what spot to put the shape copy in
        If Sheet2.Range("b" & i).Value = "HC" Then
            ActiveSheet.Range("y38").Select
            ActiveSheet.Paste
            txt = Sheet2.Range("b" & i).Offset(, -1).Value
            With Selection
            .Name = txt
            End With
            Sheet1.Shapes(txt).TextFrame.Characters.Text = txt
            Sheet1.Shapes(txt).TextFrame.HorizontalAlignment = xlHAlignCenter
            Sheet1.Shapes(txt).TextFrame.VerticalAlignment = xlVAlignCenter
            Sheet1.Shapes(txt).LockAspectRatio = msoFalse
            Sheet1.Shapes(txt).Width = w
            Sheet1.Shapes(txt).Height = h
            Sheet1.Shapes(txt).Left = 460
            Sheet1.Shapes(txt).Top = 545
        ElseIf Sheet2.Range("b" & i).Value = "HE" Then
            ActiveSheet.Range("ak33").Select
            ActiveSheet.Paste
            txt = Sheet2.Range("b" & i).Offset(, -1).Value
            With Selection
            .Name = txt
            End With
            Sheet1.Shapes(txt).TextFrame.Characters.Text = txt
            Sheet1.Shapes(txt).TextFrame.HorizontalAlignment = xlHAlignCenter
            Sheet1.Shapes(txt).TextFrame.VerticalAlignment = xlVAlignCenter
            Sheet1.Shapes(txt).LockAspectRatio = msoFalse
            Sheet1.Shapes(txt).Width = w
            Sheet1.Shapes(txt).Height = h
            Sheet1.Shapes(txt).Left = 700
            Sheet1.Shapes(txt).Rotation = 90
            Sheet1.Shapes(txt).Top = 450
        ElseIf Sheet2.Range("b" & i).Value = "HW" Then
            ActiveSheet.Range("af33").Select
            ActiveSheet.Paste
            txt = Sheet2.Range("b" & i).Offset(, -1).Value
            With Selection
            .Name = txt
            End With
            Sheet1.Shapes(txt).TextFrame.Characters.Text = txt
            Sheet1.Shapes(txt).TextFrame.HorizontalAlignment = xlHAlignCenter
            Sheet1.Shapes(txt).TextFrame.VerticalAlignment = xlVAlignCenter
            Sheet1.Shapes(txt).LockAspectRatio = msoFalse
            Sheet1.Shapes(txt).Width = w
            Sheet1.Shapes(txt).Height = h
            Sheet1.Shapes(txt).Left = 606
            Sheet1.Shapes(txt).Rotation = -90
            Sheet1.Shapes(txt).Top = 450
        ElseIf Sheet2.Range("b" & i).Value = "ER7" Then
            ActiveSheet.Range("m4").Select
            ActiveSheet.Paste
            txt = Sheet2.Range("b" & i).Offset(, -1).Value
            With Selection
            .Name = txt
            End With
            Sheet1.Shapes(txt).TextFrame.Characters.Text = txt
            Sheet1.Shapes(txt).TextFrame.HorizontalAlignment = xlHAlignCenter
            Sheet1.Shapes(txt).TextFrame.VerticalAlignment = xlVAlignCenter
            Sheet1.Shapes(txt).LockAspectRatio = msoFalse
            Sheet1.Shapes(txt).Width = w
            Sheet1.Shapes(txt).Height = h
            Sheet1.Shapes(txt).Left = 875
            Sheet1.Shapes(txt).Rotation = 90
            
        ElseIf Sheet2.Range("b" & i).Value = "ER1" Then
            ActiveSheet.Range("au4").Select
            ActiveSheet.Paste
            txt = Sheet2.Range("b" & i).Offset(, -1).Value
            With Selection
            .Name = txt
            End With
            Sheet1.Shapes(txt).TextFrame.Characters.Text = txt
            Sheet1.Shapes(txt).TextFrame.HorizontalAlignment = xlHAlignCenter
            Sheet1.Shapes(txt).TextFrame.VerticalAlignment = xlVAlignCenter
            Sheet1.Shapes(txt).LockAspectRatio = msoFalse
            Sheet1.Shapes(txt).Width = w
            Sheet1.Shapes(txt).Height = h
            Sheet1.Shapes(txt).Left = 220
            Sheet1.Shapes(txt).Rotation = -90
        ElseIf Sheet2.Range("b" & i).Value = "1" Then
            ActiveSheet.Range("m10").Select
            ActiveSheet.Paste
            txt = Sheet2.Range("b" & i).Offset(, -1).Value
            With Selection
            .Name = txt
            End With
            Sheet1.Shapes(txt).TextFrame.Characters.Text = txt
            Sheet1.Shapes(txt).TextFrame.HorizontalAlignment = xlHAlignCenter
            Sheet1.Shapes(txt).TextFrame.VerticalAlignment = xlVAlignCenter
            Sheet1.Shapes(txt).LockAspectRatio = msoFalse
            Sheet1.Shapes(txt).Width = w
            Sheet1.Shapes(txt).Height = h
            Sheet1.Shapes(txt).Left = 250
                        
        ElseIf Sheet2.Range("b" & i).Value = "2" Then
            ActiveSheet.Range("t10").Select
            ActiveSheet.Paste
            txt = Sheet2.Range("b" & i).Offset(, -1).Value
            With Selection
            .Name = txt
            End With
            Sheet1.Shapes(txt).TextFrame.Characters.Text = txt
            Sheet1.Shapes(txt).TextFrame.HorizontalAlignment = xlHAlignCenter
            Sheet1.Shapes(txt).TextFrame.VerticalAlignment = xlVAlignCenter
            Sheet1.Shapes(txt).LockAspectRatio = msoFalse
            Sheet1.Shapes(txt).Width = w
            Sheet1.Shapes(txt).Height = h
            Sheet1.Shapes(txt).Left = 395
            
        ElseIf Sheet2.Range("b" & i).Value = "3" Then
            ActiveSheet.Range("x10").Select
            ActiveSheet.Paste
            txt = Sheet2.Range("b" & i).Offset(, -1).Value
            With Selection
            .Name = txt
            End With
            Sheet1.Shapes(txt).TextFrame.Characters.Text = txt
            Sheet1.Shapes(txt).TextFrame.HorizontalAlignment = xlHAlignCenter
            Sheet1.Shapes(txt).TextFrame.VerticalAlignment = xlVAlignCenter
            Sheet1.Shapes(txt).LockAspectRatio = msoFalse
            Sheet1.Shapes(txt).Width = w
            Sheet1.Shapes(txt).Height = h
            Sheet1.Shapes(txt).Left = 490
                        
        ElseIf Sheet2.Range("b" & i).Value = "4" Then
            ActiveSheet.Range("ab10").Select
            ActiveSheet.Paste
            txt = Sheet2.Range("b" & i).Offset(, -1).Value
            With Selection
            .Name = txt
            End With
            Sheet1.Shapes(txt).TextFrame.Characters.Text = txt
            Sheet1.Shapes(txt).TextFrame.HorizontalAlignment = xlHAlignCenter
            Sheet1.Shapes(txt).TextFrame.VerticalAlignment = xlVAlignCenter
            Sheet1.Shapes(txt).LockAspectRatio = msoFalse
            Sheet1.Shapes(txt).Width = w
            Sheet1.Shapes(txt).Height = h
            Sheet1.Shapes(txt).Left = 585
            
        ElseIf Sheet2.Range("b" & i).Value = "5" Then
            ActiveSheet.Range("af10").Select
            ActiveSheet.Paste
            txt = Sheet2.Range("b" & i).Offset(, -1).Value
            With Selection
            .Name = txt
            End With
            Sheet1.Shapes(txt).TextFrame.Characters.Text = txt
            Sheet1.Shapes(txt).TextFrame.HorizontalAlignment = xlHAlignCenter
            Sheet1.Shapes(txt).TextFrame.VerticalAlignment = xlVAlignCenter
            Sheet1.Shapes(txt).LockAspectRatio = msoFalse
            Sheet1.Shapes(txt).Width = w
            Sheet1.Shapes(txt).Height = h
            Sheet1.Shapes(txt).Left = 680
                        
        ElseIf Sheet2.Range("b" & i).Value = "6" Then
            ActiveSheet.Range("aj10").Select
            ActiveSheet.Paste
            txt = Sheet2.Range("b" & i).Offset(, -1).Value
            With Selection
            .Name = txt
            End With
            Sheet1.Shapes(txt).TextFrame.Characters.Text = txt
            Sheet1.Shapes(txt).TextFrame.HorizontalAlignment = xlHAlignCenter
            Sheet1.Shapes(txt).TextFrame.VerticalAlignment = xlVAlignCenter
            Sheet1.Shapes(txt).LockAspectRatio = msoFalse
            Sheet1.Shapes(txt).Width = w
            Sheet1.Shapes(txt).Height = h
            Sheet1.Shapes(txt).Left = 775
            
        ElseIf Sheet2.Range("b" & i).Value = "7" Then
            ActiveSheet.Range("an10").Select
            ActiveSheet.Paste
            txt = Sheet2.Range("b" & i).Offset(, -1).Value
            With Selection
            .Name = txt
            End With
            Sheet1.Shapes(txt).TextFrame.Characters.Text = txt
            Sheet1.Shapes(txt).TextFrame.HorizontalAlignment = xlHAlignCenter
            Sheet1.Shapes(txt).TextFrame.VerticalAlignment = xlVAlignCenter
            Sheet1.Shapes(txt).LockAspectRatio = msoFalse
            Sheet1.Shapes(txt).Width = w
            Sheet1.Shapes(txt).Height = h
            Sheet1.Shapes(txt).Left = 870
                        
        End If
    End If
End If
Next i
ActiveSheet.Range("bk1").Select ' time updated
Selection = Now()
Application.OnTime Now + TimeValue("00:10:00"), "Ref_Click" ' timer refresh
hell:
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question
Shape objects distorting on Mac only (not Windows)
Replies
0
Views
114
rline101
R
Jaafar Tribak
  • Question
Blurring images using Direct2D & Windows Imaging Component
Replies
3
Views
240
Dan_W
D
D
  • Question
Working with images in VBA - Displaying PNG files
2
Replies
11
Views
10K
Dan_W
D
Skrej
  • Solved
All instances of a value tied to a specific entry across multiple sheets
Replies
7
Views
384
Fluff
Fluff
G
  • Question
VBA Save File Based On Filtered Change In Range
Replies
4
Views
448
GoHeels
G

Forum statistics

Threads
1,214,649
Messages
6,120,728
Members
448,987
Latest member
marion_davis

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top