I have some cells with some values. This values are the names of a pictures in a folder. I would like to show the proper picture called "value" when I click a cell "value". I would like to do it dynamically, so that adding a picture causes displaying it when a cell with its name value is clicked. Could you tell me where should I start? Are there any tutorials showing how to do this? I found many, but they use lists and store pics in excel worksheet. Are there any examples?
Private Sub CommandButton2_Click()
On Error Resume Next
Dim imageFolder As String 'this is the folder where the image is located
Dim imagePath As String
Cells.Find("Code").Offset(1).Select
Range(Selection, Selection.End(xlDown)).Select
For Each cell In Selection
imageFolder = cell.Value
imagePath = "C:\Documents and Settings\kollol\My Documents\Quotes\Image\" & imageFolder
cell.Offset(0, 2).Select
ActiveSheet.Pictures.Insert(imagePath & "\" & "1.jpeg").Select ' here the name of the image is 1.jpg
With Selection
.Placement = xlMoveAndSize
.ShapeRange.LockAspectRatio = msoTrue
.ShapeRange.Width = ActiveCell.ColumnWidth
.ShapeRange.Height = ActiveCell.RowHeight - 5
.ShapeRange.IncrementLeft 10.5
.ShapeRange.IncrementTop 4#
End With
Next cell
End Sub
Related
I am trying to insert a picture into excel based off a cell value. The Cell value is in the image path. I am new, what I have is partially based on recording the macro and part from looking stuff up. This is what I tried...
I keep getting an error on the ActiveSheet.Pictures.Insert line
Sub Part_Picture()
'
' Part_Picture Macro
'
Dim imageName As String
Dim imageFolder As String
Dim imagePath As String
For Each Cell In Range("B7")
imageName = Cell.Value
imageFolder = "Q:\New Project Part Folders\Elizabeth Delgado\Database pictures\Part\" & imageName
imagePath = imageFolder & ".jpg"
Range("B11").Select
'
ActiveSheet.Pictures.Insert(imagePath).Select
Next Cell
End Sub
"Unable to get the insert property of the Pictures class" is a generic error message which you may as well just translate as "Something went wrong with what you're trying to do and I can't give you more information". It's likely though that the path to the image file has not been build correctly.
1) Remove the .Select from your insert statement. Syntactically it makes no sense. Just use ActiveSheet.Pictures.Insert(imagePath)
2) Check the value in cell B7 is the file name only, not including the extension. Since your code adds ".jpg" you dont need that in B7.
3) Check the file is actually a jpg, not for instance a png
4) Check the file / folder actually exists
FYI For Each Cell In Range("B7") is only going to iterate one cell - B7 - and is unnecessary. If you only intended for one cell to be read you should use imageName = Range("B7").Value, or better yet since you need a string use imageName = Range("B7").Text
Consider this option.
Sub InsertPics()
Dim fPath As String, fName As String
Dim r As Range, rng As Range
Application.ScreenUpdating = False
fPath = "C:\your_path_here\"
Set rng = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
i = 1
For Each r In rng
fName = Dir(fPath)
Do While fName <> ""
If fName = r.Value Then
With ActiveSheet.Pictures.Insert(fPath & fName)
.ShapeRange.LockAspectRatio = msoTrue
Set px = .ShapeRange
If .ShapeRange.Width > Rows(i).Columns(2).Width Then .ShapeRange.Width = Columns(2).Width
With Cells(i, 2)
px.Top = .Top
px.Left = .Left
.RowHeight = px.Height
End With
End With
End If
fName = Dir
Loop
i = i + 1
Next r
Application.ScreenUpdating = True
End Sub
' Note: you need the file extension, such as ',jpg', or whatever you are using, so you can match on that.
Whatever picture name you put in Column A, will be imported into the adjacent cell in, Column B
The .Pictures.Insert("c:\fixedfile.png") asked a fix file name as its parameter. However you may use FileCopy "desiredfile.png", "fixedfile.png" to replace the content of fixedfile.png which then meet your needs.
This code inserts a picture into my excel worksheet, from a specific folder, by entering the name of the picture into a cell. For example, if I was to enter a1.jpg into cell J4, I would then get an output of the image that I want from the folder to a cell that is one space to the right of J4.
The dilemma I'm having is that my excel template has various sized cells and I am trying to place the picture in a specific location but having a hard time. This is because the current code moves the picture by cells so if the cell is too long, the picture will be moved the whole length of the cell. I was wondering if this could be changed such that the image can be placed directly at a certain point and not designated by cells.
code credit goes to pokemon_Man
The code is as follows:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim imagePath, fileName, fullImagePath, newImageLoc As String
imagePath = "C:\YourFileLocationPath\"
If Target.Address = "$J$4" Then
fullImagePath = imagePath & Target.Value
newImageLoc = Target.Offset(, 1).Address
With ActiveSheet.Pictures.Insert(fullImagePath)
.Left = ActiveSheet.Range(newImageLoc).Left
.Top = ActiveSheet.Range(newImageLoc).Top
.Placement = 1
.PrintObject = True
End With
End
End If
End Sub
Try:
.Left = Target.Left + Target.Width / 2
.Top = Target.Top + Target.Height / 2
I have an Excel worksheet that i use as a printable single page PDF report that contains an image with some text. In a column to the side I have a list of all the images in a specific folder and i would like to use VBA to cycle through the list replacing the image in the worksheet and creating a PDF to be stored in the same folder. I currently do this manually which is a pain and would like to automate it with VBA.
Any help would be greatly appreciated.
Thanks in advance.
The code i use manualy by changing the full path of the image to be replaced is as follows>
Sub AddPicturesFULL()
Dim myPic As Picture
Dim wkSheet As Worksheet
Dim myRng As Range
Dim myCell As Range
Dim rowCount As Long
Dim rowCount2 As Long
Dim Pic As Object
Set wkSheet = Sheets("REPORT(FULL)") ' -- Change to your sheet
For Each Pic In wkSheet.Pictures
Pic.Delete
Next Pic
'-- The usual way of finding used row count for specific column
rowCount2 = wkSheet.Cells(wkSheet.Rows.Count, "N").End(xlUp).Row
If rowCount2 <> 0 Then
Set myRng = wkSheet.Range("N2", wkSheet.Cells(wkSheet.Rows.Count, "N").End(xlUp))
For Each myCell In myRng.Cells
If Trim(myCell.Value) = "" Then
'MsgBox "No file path"
ElseIf Dir(CStr(myCell.Value)) = "" Then
MsgBox myCell.Value & " Doesn't exist!"
Else
'myCell.Offset(0, 1).Parent.Pictures.Insert (myCell.Value)
Set myPic = myCell.Parent.Pictures.Insert(myCell.Value)
With myCell.Offset(0, -13) '1 columns to the right of C ( is D)
'-- resize image here to fit into the size of your cell
myPic.Top = .Top
myPic.Width = .Width
myPic.Height = 640
myPic.Left = .Left
myPic.Placement = xlMoveAndSize
myPic.SendToBack
End With
End If
Next myCell
Else
MsgBox "There is no file paths in your column"
End If
End Sub
Create an ActiveX Image on the Sheet instead of using drawing Pictures
Then you can use
Dim i As Integer
For i = 1 To 20 Step 1
imgTest.Picture = LoadPicture(Sheets("Sheet1").Cells(i, COLUMN).Value)
Sheets("Sheets1").ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\test" & i & ".pdf", Quality:=xlQualityStandard
Next i
To loop through the column with imagepaths and set the image for each of them. Then just export it as a PDF.
Of course you have to adjust the i values and COLUMN to your needs.
This is how I am inserting the picture: format it, cut it, paste it into the right cell and then grab it by the .top and .left. I've done it this way so that the picture will move with the rows when sorting (if I just .addpicture it won't get sorted).
...But now that I have solved the sorting problem, the .ClearComments started deleting the pictures instead of the comments. (It will also delete the comments, but it first deletes the pictures!)
Any ideas on how to solve this?
Dim myPicture as Picture
Dim pictShape as Shape
Dim oCell as Range
Set myPicture = ActiveSheet.Pictures.Insert("http://img.youtube.com/vi/" & VideoURL & "/default.jpg")
With myPicture
.ShapeRange.PictureFormat.CropTop = 7.96
.ShapeRange.PictureFormat.CropBottom = 8.225
.ShapeRange.LockAspectRatio = msoTrue
.Height = pixHeight
.Top = pixTop
.Left = pixLeft
End With
Set pictShape = ActiveSheet.Shapes(myPicture.Name)
pictShape.Cut
oCell.PasteSpecial
For Each Sh In ActiveSheet.Shapes
If Sh.Top = pixTop And Sh.Left = pixLeft Then 'found it!
Sh.Name = "Picture " & i
Exit For
End If
Next Sh
Set pictShape = ActiveSheet.Shapes("Picture " & i)
With pictShape
.Top = pixTop
.Left = pixTop
End With
Solved. Do not use .PasteSpecial on shapes when planing to use .ClearComments, instead use .Paste.
Set ExcSel = Selection ' save previous selection
oCell.Select ' select cell to paste to
ActiveSheet.Paste ' paste
ExcSel.Select ' select the originaly selected cell
I want to display to the user certain information that exists on a separated worksheet, whenever he clicks a button.
I can set Excel to "go" to this worksheet at the starting line of the range , but I could not find a way to hide everything else.
Is there some method for this, or do I have to hide all rows and columns?
Insert a UserForm in the Workbook's VB Project.
Add a ListBox control to the userform.
Then do something like this code in the UserForm_Activate event code:
Private Sub UserForm_Activate()
Dim tbl As Range
Set tbl = Range("B2:E7") '## Change this to capture the rang you need '
Me.Caption = "Displaying data from " & _
ActiveSheet.Name & "!" & tbl.Address
With ListBox1
.ColumnHeads = False
.ColumnCount = tbl.Columns.Count
.RowSource = tbl.Address
End With
End Sub
Which gives unformatted data from the range:
To export the range as an image, you could create an Image in the UserForm instead of a Listbox. Then this should be enough to get you started.
As you can see from this screenshot, the image might not always come out very clearly. Also, if you are working with a large range of cells, the image might not fit on your userform, etc. I will leave figuring that part out up to you :)
Private Sub UserForm_Activate()
Dim tbl As Range
Dim imgPath As String
Set tbl = Range("B2:E7") '## Change this to capture the rang you need '
imgPath = Export_Range_Images(tbl)
Caption = "Displaying data from " & _
ActiveSheet.Name & "!" & tbl.Address
With Image1
If Not imgPath = vbNullString Then
.Picture = LoadPicture(imgPath)
.PictureSizeMode = fmPictureSizeModeClip
.PictureAlignment = 2 'Center
.PictureTiling = False
.SpecialEffect = 2 'Sunken
End If
End With
End Sub
Function Export_Range_Images(rng As Range) As String
'## Modified by David Zemens with
' credit to: _
' http://vbadud.blogspot.com/2010/06/how-to-save-excel-range-as-image-using.html ##'
Dim ocht As Object
Dim srs As Series
rng.CopyPicture xlScreen, xlPicture
ActiveSheet.Paste
Set ocht = ActiveSheet.Shapes.AddChart
For Each srs In ocht.Chart.SeriesCollection
srs.Delete
Next
'## Modify this line as needed ##'
fname = "C:\users\david_zemens\desktop\picture.jpg"
On Error Resume Next
Kill fname
On Error GoTo 0
ocht.Width = rng.Width
ocht.Height = rng.Height
ocht.Chart.Paste
ocht.Chart.Export Filename:=fname, FilterName:="JPG"
Application.DisplayAlerts = False
ocht.Delete
Application.DisplayAlerts = True
Set ocht = Nothing
Export_Range_Images = fname
End Function
If you record a macro and hide some columns and rows manually, the code will be produced for you, and you will see how it's done.