Using VBA is it possible to load an image into a shape

[geopetlas]

I was just wondering if it is possible to use VBA that could load an image, stored locally, into a shape on the worksheet?

Purpose for this is that I have a graph and I would like to position an unfilled shape behind the plot area, which has zero transparency, and that shape then would have a different image loaded in it depending on the value entered in a specific cell.

Already have some code that would automatically run the macro. Just need the picture into a shape code.

Private Sub Worksheet_Change(ByVal Target As Range)


If Target.Address = "$B$3" Then
Application.EnableEvents = False


' code for picture into shape should go here


Application.EnableEvents = True


End If


End Sub

Am using Excel 2016

Thanks in advance
George

 

[RickXL]

OK.

I have assumed by Table Array you mean that you have the data in a ListObject type Table? These are useful because you do not have to change anything if you add more rows later.

From the top, then:

I created a second sheet called Sheet2.
In row 2, I inserted "Name" in column A and "File" in column AU.
I created a list of names in column A under Name.
I added a list of files under File.
Then I converted the whole thing into a Table using Ctrl + T. Make sure all the columns are mentioned in the dialog that pops up.
Go into Formulas-->Name Manager and change the table name to Planes.

Back on Sheet1:
I added a Data Validation object to cell C5.
In the validation dialog I set Allow: to List
Source: was set to: =INDIRECT("Planes[Name]")
OK out and you should have a working dropdown list.

Now add this code to the code module for Sheet1:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim iPathRow As Long
    If Target.Address = "$C$5" Then
        iPathRow = WorksheetFunction.Match(Target, Application.Range("Planes[Name]"), 0)
        If Not IsError(iPathRow) Then
            With Shapes("Oval 1").Fill
                .UserPicture Application.Range("Planes[File]")(iPathRow)
            End With
        End If
    End If
End Sub

If cell C5 changes it will use MATCH to find the row where the selected value occurs.
If a valid row is found then the file path will be added from the File column (AU) to the fill command.

Using a ListObject/Table like this means that you can add and remove rows without needing to change the code or the Data Validation List. You can also re-arrange the columns on Sheet2 and as long as the column headings remain it will still work.

If you haven't used a Table and can't make the above work then come back and I will do it the boring way.

Best of luck,

 

[geopetlas]

Thanks Rick,

I was working on this too and came up with this

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim keyPress As Range
    Dim strName As String
        Dim picName As String
    Set keyPress = Range("c4")
        If Not Application.Intersect(keyPress, Range(Target.Address)) _
           Is Nothing Then
        strName = Worksheets("sheet1").Range("c4")
        picName = Application.WorksheetFunction.VLookup(strName, Sheet2.Range("A3:AU8"), 47, False)
        With Shapes("Rectangle 2").Fill
           .UserPicture picName
       End With
      
    End If
End Sub

 

[geopetlas]

Opps, Forgot to say Thanks.

George

 

[RickXL]

No problem.

If we do it your preferred way I think it reduces to this:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim picName As String
    If Not Intersect(Range("C4"), Target) Is Nothing Then
        picName = WorksheetFunction.VLookup(Target, Sheet2.Range("A3:AU8"), 47, False)
        Shapes("Rectangle 2").Fill.UserPicture picName
    End If
End Sub

Regards,

 

[geopetlas]

Wow Rick I like your method much better, but now I have a new question.What I now did was in the Table in sheet2 Row 2 Col B, renamed to "Tail", I added the value: N000 in Row 3 Col B.When Piper is selected from the drop down list how do I get the value from Sheet2 Row 3 Col B(Tail) to show up in Sheet 2 Row 10 Col B.Sheet 2

	Col A	Col B	Col AU
Row 1	Name	Tail	File
Row 2	Cessna	N0000	file path 1
Row 3	Piper	N1111	file path 2
Row 10		N1111

<tbody> </tbody>

The way I did it before was using VlookUp. But now with this new way you suggested I'm thinking that if I use the VLOOKUP method then every time a new item is added to the list I would have to go to every Col (there are 47 of them) in row 10 and change the array range. Talk about drudgery!Can INDERECT or another method be used to allow for the expandability of the table to load the values instead of VLOOKUP?GeorgePS: You know after all of this I'm going owe you a cold beer, or a shot, or a cup of hot coffee

 

[RickXL]

You know after all of this I'm going owe you a cold beer, or a shot, or a cup of hot coffee

Has the invoice not arrived, yet?

Unfortunately, I can't quite understand what you are trying to do. In my mind, Sheet2 is a look-up table so you won't be adding something to it every time you select a picture.

Why would you need to repeat a value somewhere else on the sheet? Why not just the one on the row you already located?

To do what you said this is the code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim picName As String
    If Not Intersect(Range("C4"), Target) Is Nothing Then
        picName = WorksheetFunction.VLookup(Target, Sheet2.Range("A3:AU8"), 47, False)
        Shapes("Rectangle 2").Fill.UserPicture picName
        Sheet2.Range("B10") = WorksheetFunction.VLookup(Target, Sheet2.Range("A3:AU8"), 2, False)
    End If
End Sub

but I don't think you meant that ...?

By the way, I assumed we are talking about the code in post #14?

 

[geopetlas]

I was referring to your code in post #11

To illustrate what I'm trying to do go to:

https://view.officeapps.live.com/op...ml.tech.purdue.edu/airframeimages/c172w&b.xls

Download it and give it a try.

That example is a basic weight and balance calculator for a single type aircraft'
You'll see that there are calculation made based on certain criteria for a specific aircraft. The criteria changes based on options added to the plane.
This example is for one type of aircraft.

What I want to do is make a workbook that will allow you to add numerous aircraft of various types.
The formulae for each calculation, regardless of plane are the same, but as I stated each aircraft has different criteria.
I will also make some other calculations not mentioned in the example from Purdue.

So, hopefully, you'll see why I need to call different values associated with an aircraft.

You asked, "Why would you need to repeat a value somewhere else on the sheet? Why not just the one on the row you already located?"

A gosh-darned good question!
And as I mentioned at the onset of this thread, my knowledge of excel is very limited. Lot of the lesser things I learn as I go, but there are problems like this one that I just can't figure out so I ask someone who knows.

So using your method of having a table as you described in post# 11, is there a way other than VLOOKUP, which is what I was using before, to get the values from Sheet2 to cells in Sheet1?

And no, your invoice hasn't arrived yet

George

 

[RickXL]

OK, I have re-calibrated myself now:

If, say, you needed to write the associated value of Tail into cell D4 on Sheet1 then you could do this:
[/code]
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iPathRow As Long
If Target.Address = "$C$4" Then
iPathRow = WorksheetFunction.Match(Target, Application.Range("Planes[Name]"), 0)
Shapes("Rectangle 2").Fill.UserPicture Application.Range("Planes[File]")(iPathRow)
Range("D4") = Application.Range("Planes[Tail]")(iPathRow)
End If
End Sub
[/code]

In fact, if I needed to refer to any more variables in that piece of code I might move the reference to "Application". For instance:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim iPathRow As Long
    If Target.Address = "$C$4" Then
        With Application
            iPathRow = WorksheetFunction.Match(Target, .Range("Planes[Name]"), 0)
            Shapes("Rectangle 2").Fill.UserPicture .Range("Planes[File]")(iPathRow)
            Range("D4") = .Range("Planes[Tail]")(iPathRow)
        End With
    End If
End Sub

Just watch which Ranges have dots and which do not.

Basically,

Application.Range("Planes[Tail]")(iPathRow)

Application.Range("Planes") will find the Table.
Adding the column heading inside square brackets will locate the column.
Adding the row index at the end will find the row.

 

[geopetlas]

Okay, I get it now. From this point I believe that I can carry on.

Rick, I really appreciate all the time and effort that you have expended in resolving this issue for me.

George

 

[RickXL]

Hi, no problem - I come here anyway!

I perhaps ought to mention that the way I use Tables in VBA is not exactly as Microsoft intended but I find the "approved" way too long-winded.

See this link for some more mainstream examples: The VBA Guide To ListObject Excel Tables

Anyway, I was pleased to be of use. Good luck with the project and if you get stuck - well, you know where we are.

Regards,