I have a Vlookup set up from a selection in a drop down window. This is easy. What I am finding difficult is once I select a name, I need their image to show up in an area of my worksheet. Any help would be appreciated. I am using Excel 2010. Thank you.
If you put a picture into your worksheet in the location that you want then you can just use that pictures properties to insert a new picture (after deleting the old one). Alternatively, you could set the size properties as constants. Paste this code into a module:
Const PicturePath = "C:\Users\Public\Pictures\Sample Pictures\"
Sub ChangePicture(PictureName)
Dim p As Picture
Dim ptop, pleft, pwidth, pheight
On Error GoTo errorhandler
For Each p In ActiveSheet.Pictures
ptop = p.Top
pleft = p.Left
pwidth = p.Width
pheight = p.Height
p.Delete
Next p
ActiveSheet.Pictures.Insert (PicturePath & PictureName)
For Each p In ActiveSheet.Pictures
p.Top = ptop
p.Left = pleft
p.Width = pwidth
p.Height = pheight
Next p
Exit Sub
errorhandler:
MsgBox "Error loading file, check the filename to make sure it is valid.", _
vbCritical, "ChangePicture"
End Sub
then add this code to the worksheet with your picture names
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Value <> "" Then
ChangePicture Target.Value
End If
End Sub
In the worksheet, if you have a list of picture names like
Desert.jpg
Jellyfish.jpg
Koala.jpg
then when you click on one, the code will run and insert your new picture in place of the old one. This should at least get you started, and you can tweak the code to suit your purposes. Make sure you have a picture in your worksheet, that is the size and position that you want, and then the new picture will be in the same place, and the same size.
Related
Apologies another noob question. I have been tasked with writing a document within excel, the front cover has a lot of images on it and i have grouped these images together. As there is a risk that the user could move this group. I want to set it so each time that sheet is selected it moves back to its original location. I have looked over the web and i can't seem to find anything for a group of images.
I have tried this and it doesnt work at all. :(
Private Sub Worksheet_Activate()
Dim PicGroup As GroupShapes
With Range("A1")
PicGroup.Name = "HeaderGrp"
PicGroup.Visible = True
PicGroup.Top = .Top
PicGroup.Left = .Left
End With
End Sub
So my group of images I have called HeaderGrp I have put this on Activate Worksheet in VBA and i want this to always move or fix to cells A1.
I would also love this to fit to the page width and length if anyone knows how to do that.
Snapshot of what i would like: -
1) on sheet selection, image group moves to the correct location.
2) image group auto adjusts to page width and height.
Thank you in advance,
This works for me. Pictures appear to be treated as a type of Shape.
Private Sub Worksheet_Activate()
Dim p As Shape
With activesheet
Set p = .Shapes("Pics") 'name
p.Top = .Range("a1").Top
p.Left = .Range("a1").Left
End With
End Sub
This piece of code should get your grouped images:
Option Explicit
Private Sub Worksheet_Activate()
Dim shp As Shape
Dim PicGroup As GroupShapes
'loop through all your shapes
For Each shp In Me.Shapes
'if the shape is grouped then
'set your PicGroup variable
'and exit the loop
If shp.Type = msoGroup Then
Set PicGroup = shp.GroupItems
Exit For
End If
Next shp
With Range("A1")
PicGroup.Name = "HeaderGrp"
PicGroup.Visible = True
PicGroup.Top = .Top
PicGroup.Left = .Left
End With
End Sub
I'm trying to use VBA in Excel to convert a bunch of pictures in a column (one per cell) to a pop up comment image instead so that the sheet is more easily readable.
I can find the image I need by iterating through the shapes, and I can set this as an object; but I can't seem to use that onject to populate the comment field. It seems to be looking for a true file path instead.
I don't particularly want to have to save each image and then reload it, seems kind of pointless.
For Each Pic In ActiveSheet.Shapes
If Pic.TopLeftCell.Address = ActiveCell.Address Then
If Pic.Type = msoPicture Then
Pic.Select
Application.ActiveCell.AddComment.Shape.Fill.UserPicture **(ActiveSheet.Shapes(Pic.name))** 'if I use a path here its okay
'SelectPictureAtActiveCell = name
Exit For
End If
End If
Next
any thoughts?
CJ
I think you want to show one image if you select a specific cell then
See
Making shapes invisible/visible in excel through VBA
with
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Macro1
End Sub
You can make images hide and show using
ActiveSheet.Shapes("ImageName").Visible = False or True
for example when you click on cell A1 first image is hidden else all images are visible
Sub Macro1()
Dim shp As Shape
If ActiveCell.Address = "$A$1" Then
For Each shp In ActiveSheet.Shapes
ActiveSheet.Shapes(1).Visible = False
' or you can use image name as
'ActiveSheet.Shapes("ImageName").Visible = False
'shp.Visible = False
Next
Else
For Each shp In ActiveSheet.Shapes
shp.Visible = True
Next
End If
End Sub
I have a file that someone made and I was tasked with simply adding an autoupdater function that updates the cell next to the dropdown menu.
The way the dropdown menu is created is by going to data validation and selecting list and make list in cell. The values are read from elsewhere.
Now, what I tried was to loop over all shapes like this:
Dim dd As DropDown
Dim i As Integer
Debug.Print Sheet1.DropDowns.Count
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
Dim s As Shape
For Each s In ws.Shapes
Debug.Print CStr(s.Type)
Next
Next
End Sub
This prints the following:4 is a comment, 8 is a control form
444444444444444444444444444
8
So even though I have many drop down menus none come out when I loop over them.
I wanted to make it so that anyone can add a dropdown box and my code would attach an OnAction Sub that fills in the cell next to the dropdown box so the user can add as many boxes they want, but they have to only remember to keep the cell next to it, to the right for example, empty as it will be overridden.
Dim sh As Shape
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
For Each sh In ws.Shapes
If sh.Type = msoFormControl Then
If sh.FormControlType = xlListBox Then
sh.OLEFormat.Object.OnAction = "UpdateLBCell"
End If
End If
Next
Next
The original code above causes an object error on the innermost line.
Am I just stupid or is it not possible to loop over these dropdown boxes?
If it is impossible, can I make some other dropdown single select boxes that fit inside a cell? Combobox I tried, but they lie on top and dont match.
Any insight in alternative ways to do this is very appreciated as well.
I put a list validation on a few cells, then ran this code
Sub Test()
Dim dd As DropDown
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
Dim s As Shape
For Each s In ws.Shapes
Debug.Print CStr(s.Type), s.Top, s.Left
s.Visible = msoCTrue '<<<<
Next
Next
End Sub
Before and after (yellow cells have data validation):
So it seems as though if you have a "list" data validation set up, Excel manages a single (normally invisible and empty) drop-down which is typically positioned at the current active cell. It's only made visible when that's also one of the cells with validation set up.
EDIT: here's an example of how you could handle updates to cells with drop-down DV lists in a generic way -
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
On Error GoTo haveError
Application.EnableEvents = False
For Each c In Target.Cells
If HasDVList(c) Then
c.Offset(0, 1) = Now
End If
Next c
haveError:
Application.EnableEvents = True
End Sub
'does a cell have DV list?
Function HasDVList(rng As Range)
Dim v
On Error Resume Next
v = rng.Cells(1).Validation.Type
On Error GoTo 0
HasDVList = (v = 3)
End Function
The Shape should be Visible, whether the cell is "clicked-on" or not. I put a single DV dropdown on a sheet and ran:
Sub ShapeLister()
Dim s As Shape
For Each s In ActiveSheet.Shapes
MsgBox s.Type & vbCrLf & s.Name
Next s
End Sub
and got:
Try this on a fresh worksheet and tell us what you see.
Here is the macro which is in the Sheet1 module:
Private Sub Worksheet_Calculate()
Dim oPic As Picture
Me.Pictures.Visible = False
With Range("F1")
For Each oPic In Me.Pictures
If oPic.Name = .Text Then
oPic.Visible = True
oPic.Top = .Top
oPic.Left = .Left
Exit For
End If
Next oPic
End With
End Sub
In the work book this is what it looks like:
How do I gain access to Me.Pictures? We'd like to add pictures and delete some of the existing pictures.
Try running this which just uses the third line in your existing code
Private Sub MakeAllPicsVisible()
Me.Pictures.Visible = True
End Sub
Me refers to the worksheet object the code is in. And each picture appears to be named with the items in the list
To change the picture name, enter a new name via the Name Box (left of Formula bar).
I have submitted question on Excel - Autoshape get it's name from cell (value) but every my reply get's deleted so I will open new one.... please don't delete now
This is file and works fine but I have to use now only square shapes
File
in way home1, home2, office1, office2, stair1, stair2.. to indicate locations that if user change home in the list to building it changes only squares that have that name and not others...? or office to elevator only office shapes are updated
this column A with shapes can be deleted and leave only B name and C number as I use only squares
sorry don't know so much about VBA
check image
image
This can be achieved with a _Change event on the shapes worksheet. Add this to the Shapes sheet vba
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim shp As Shape
Dim nw As Variant
Dim old As Variant
' in case there is an error...
On Error GoTo CleanUp
Set rng = Intersect(Target, [Shape])
If Not rng Is Nothing Then
' Save new name
nw = Target
' Prevent events firing while we change sheet values
Application.EnableEvents = False
' Get previous name
Application.Undo
old = Target
' Restore new name
Target = nw
' Rename selected Shapes
For Each shp In Me.Shapes
If shp.Name Like old & "#*" Then
shp.Name = nw & Mid(shp.Name, Len(old) + 1)
End If
Next
End If
CleanUp:
' Re-enable events
Application.EnableEvents = True
End Sub