Help with photos in Excel
Posted by Paul on November 13, 2001 5:17 AM
I have a Marco that inserts a photo from a folder on C drive when an item in a dropdown list is picked, I want to be able to store the photos in the same workbook and still be able to insert them.Can this be done? i am using Excel '97. Thanks in advance for your help.
Posted by Hodge on November 13, 2001 6:11 AM
When you paste a picture into a sheet, it stores it as "Picture 1", etc. (which you can change). You can then treat that OBJECT in a way similar to a range in any macro. Don't know the details, as I haven't worked with Objects much.
Posted by Joe Was on November 13, 2001 11:00 AM
This code adds a photo to the end of a photo log on a worksheet, the user is prompted with an Input box for the file name and location. A text box is added to the right of the photo object. The code was setup to work from a form button. Each photo is spaced two rows down from the last photo. As photos are added the photo object is coded with the photo location. The code works on the active sheet, in this case "Photos." JSW
Sub s_Photos()
'Adds a photo below the last photo if any.
Range("D65536").End(xlUp).Offset(4, -2).Select
'xlUp needs a text cell to set.
ActiveCell.RowHeight = 118.5
ActiveCell.ColumnWidth = 32.43
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
myFile = Application.InputBox("Enter your, ""Drive:\Path\File.jpg"" for your Photo." _
& Chr(13) & Chr(13) & " Like, C:\MyFiles\JSW\Excel\FOREST03.JPG" & Chr(13) & Chr(13) _
& " In the box below!", Title:="Please indicate the photo location!")
On Error GoTo Kil
ActiveSheet.Pictures.Insert(myFile).Select
Selection.ShapeRange.ScaleHeight 0.34, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleWidth 0.33, msoFalse, msoScaleFromTopLeft
With Selection
.Placement = xlMoveAndSize
.PrintObject = True
End With
ActiveCell.Offset(0, 2).Select
Selection.Interior.ColorIndex = xlNone
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
ActiveCell.FormulaR1C1 = "Photo: "
With ActiveCell.Characters(Start:=1, Length:=8).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("A1").Select
Kil:
Range("A1").Select
End Sub
