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
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 have an excel that has 1 column with picture in each cell, that picture determines something but i would like to change it to 1 instead. There is only 1 picture, and to my exact, the column is J;Name =PO history/release documentation . Can someone help me to do it with VBA Thank you!
Public Sub Replace_Picture()
Const Replace_Text = "OK"
Dim shp as Shape
For Each shp In ActiveSheet.Shapes
If shp.TopLeftCell.Address = shp.BottomRightCell.Address Then
shp.TopLeftCell.Value = Replace_Text
shp.Delete
End If
Next
Set shp = Nothing
End Sub
I tried the above code but its not working and const replace_text is in red.
I just want to change those cells with the picture to "1", while those blanks will be leave it to be.
I guess you want to delete the PO history shapes from SAP.
you may have a try by below VBA code.
Another way is you may 'Copy+Paste' data from SAP directly instead of 'Export to Excel'
Sub Replace_Shapes()
Dim Shp As Shape
Dim Shp_Address
For Each Shp In ActiveSheet.Shapes
If Shp.Type = msoPicture Then
'Identify the address of Shape by TopLeft
Shp_Address = Shp.TopLeftCell.Address
Range(Shp_Address) = 1
Shp.Delete
End If Next
End Sub
I have 2 sheets on excel, one called Raw and one called Graphs. What I want to do is have some cells in Raw and it they =TRUE then I want a shape to appear on the Graphs page.
I am pretty new to VBA so i havent tried much :(
Private Sub Worksheet_Calculate()
With Worksheets("Graph")
If Me.Range("FK45").Value = True Then
.Shapes("Test1").Visible = True
Exit Sub
ElseIf Me.Range("FK45").Value = False Then
.Shapes("Test1").Visible = False
Exit Sub
End If
End With
End Sub
I can get this to work so if FK45 is TRUE the image shows but if FK45 is FALSE it doesn't, But what I want to be able to do is add more to this e.g.
Private Sub Worksheet_Calculate()
With Worksheets("Graph")
If Me.Range("FK45").Value = True Then
.Shapes("Test1").Visible = True
Exit Sub
ElseIf Me.Range("FK45").Value = False Then
.Shapes("Test1").Visible = False
Exit Sub
End If
End With
With Worksheets("Graph")
If Me.Range("FK46").Value = True Then
.Shapes("Test2").Visible = True
Exit Sub
ElseIf Me.Range("FK46").Value = False Then
.Shapes("Test2").Visible = False
Exit Sub
End If
End With
End Sub
I want them all to be independent from each other and be able to add more if necessary
If FK45 is TRUE Image1 shows
If FK45 is FALSE Image1 doesn't show
and/or
If FK46 is TRUE Image2 shows
If FK46 is FALSE Image2 doesn't show
and/or
If FK47 is TRUE Image3 shows
If FK47 is FALSE Image3 doesn't show
and so on...
This is how I would do it
In VB Editor find your Worksheet and Shape objects and rename their system name to something intutive in their respective property windows.
This way you can get rid of With Worksheets("Graph") construction, instead you can call them by their system name like With Graph. This will also come in handy if you wish to rename your worksheets or shapes.
Note that you Exit Sub after each cell check, your procedure stops after first cell and doesn't proceed any further.
Instead of Worksheet.Calculate event I advise using Worksheet.Change. This way you can iterate through your cells one by one.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngCell As Range
Dim shpImage As Shape
For Each rngCell In Target.Cells
' check if change was made in "FK"
If Not Intersect(rngCell, Me.Columns("FK")) Is Nothing Then
Select Case rngCell.Row
Case 45: Set shpImage = Graph.MyImage_1
Case 46: Set shpImage = Graph.MyImage_2
End Select
' if only boolean values present, no need for IF construction
shpImage.Visible = rngCell.Value : Set shpImage = Nothing
End If
Next
End Sub
If you had separate column for image name it would be much easier, you could check like this (for example, shape names are located in "FL" column)
Graph.Shapes(rngCell.Offset(0, 1).Value).Visible = rngCell.Value
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.
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).