Dec 02 2020 12:54 PM - edited Dec 02 2020 01:01 PM
I'm looking to simply run a macro that finds a picture's location in one cell and then insert the picture into another cell. But it has to be attached to a cell so it can be sorted AND be an actual picture vs a link.
I've tried 2 versions with each having it's own issues:
1 - ActiveSheet.Pictures.Insert(picname).Select ', LinkToFile:=msoFalse, SaveWithDocument:=msoTrue
** This one attaches to cells, and inserts the pictures, but ONLY as links, so the spreadsheet can't be sent to anyone.
2 - ActiveSheet.Shapes.AddPicture Filename:=picname, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=Cells(CurRow, PicLocCol).Left, Top:=Cells(CurRow, PicLocCol).Top, Height:=80, Width:=100
** This one attaches a picture (vs a link) and can be sent, but won't attach to cells, so it can't be sorted.
PS: I don't know exactly how to attach code, so I'm attaching it as a DOC file.
The spreadsheet currently has 2 columns.
B - C:\pic1.jpg
A - C:\pic2.jpg
C - C:\pic3.jpg
I added the letters in column A (out of order to test the sorting), and a pic location in Column B
Dec 03 2020 11:15 AM
I found a partial work around ... but it's horrible to think this has to be done.
You can use the first option to insert the pictures / attached to cells as links, then convert it to a PDF. The PDF can be sent, etc. Then convert it from PDF back to an Excel file. While this seems like a really bad work around, I haven't found any other options yet.
Dec 03 2020 12:25 PM
I'm not sure if I understood it correctly from the translation, but I'm still sending you this VBA code with a selection function. If this is not what you had in mind, just ignore it.
Option Explicit
Sub InsertPicture()
Dim sPicture As String, pic As Picture
sPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
, "Select Picture to Import")
If sPicture = "False" Then Exit Sub
Set pic = ActiveSheet.Pictures.Insert(sPicture)
With pic
.ShapeRange.LockAspectRatio = msoFalse
.Height = ActiveCell.Height
.Width = ActiveCell.Width
.Top = ActiveCell.Top
.Left = ActiveCell.Left
.Placement = xlMoveAndSize
End With
Set pic = Nothing
End Sub
I would be happy to know if I could help.
Nikolino
I know I don't know anything (Socrates)
* Kindly Mark and Vote this reply if it helps please, as it will be beneficial to more Community members reading here.
Dec 03 2020 01:58 PM
@NikolinoDE Thank you again for your response. But this doesn't seem to work.
The pictures are not actually inside the spreadsheet. For example if you email the spreadsheet and attempt to open it on another device or using office online, you will notice the picture are not there.
Dec 04 2020 02:05 AM
Its Works for me
Look the file please.
* It is also helpful to know the operating system and Excel version, as different approaches may be required depending on the version and OS.
I would be happy to know if I could help.
Nikolino
I know I don't know anything (Socrates)
Dec 04 2020 02:50 AM
May 14 2021 12:54 AM - edited May 14 2021 12:57 AM
Refactoring code from Nikolino, you can have some more options, although given we don't know what you wanna do with the pictures later, it will lack some functionality you are looking after (the sort thing...).
Sub insertPicture()
Dim owsh As Excel.Worksheet
Dim rng As Excel.Range
Dim oShp As Excel.Shape
Dim strFile As String
strFile = Application.GetOpenFilename("Graphic files (*.jpg; *.gif; *.png)," & "*.jpg; *.gif; *.png")
If strFile <> CStr(False) Then
Set owsh = ActiveSheet
With owsh
On Error Resume Next
Set rng = Application.InputBox("Select target cell:", "Insert Picture", ActiveCell.Address, Type:=8)
On Error GoTo 0
If Not rng Is Nothing Then
Set oShp = .Shapes.AddShape(msoShapeRectangle, rng(1, 1).Left, rng(1, 1).Top, rng(1, 1).Width, rng(1, 1).Height)
With oShp
'!!!!! alternative
.Visible = msoFalse
With .Fill
.Visible = msoTrue
.UserPicture strFile
.TextureTile = msoFalse
End With
With .TextFrame2.TextRange.Characters
With .Font
.Size = 11
With .Fill
.Visible = msoTrue
With .ForeColor
.ObjectThemeColor = msoThemeColorLight1
.TintAndShade = 0
.Brightness = 0
End With
'!!!!! alternative
.Transparency = 1 ' ranges({0 = solid} to {1 = hidden})
.Solid
End With
End With
With .ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignLeft
End With
.Text = strFile
End With
'!!!!! alternative
'.AlternativeText = strFile
End With
'!!!!! alternative
'.Hyperlinks.Add Anchor:=oShp, Address:=strFile
rng(1, 1).FormulaR1C1 = strFile
End If
End With
End If
Set rng = Nothing
Set oShp = Nothing
Set owsh = Nothing
End Sub
As you can see, the picture is "inserted" in the workbook, so it can be referred. I have hidden the image inserted
You have some options to continue with the sort issue, as the shapes will be not linked to the cells (so they will not sort):
All the alternatives you have are marked with the '!!!!! alternative tag, so you can choose which one better fits your needings.
Kind regards
May 14 2021 03:10 AM
May 14 2021 09:29 AM