VBA Excel Macro - Picture attached to Cell (insert) - Not link

%3CLINGO-SUB%20id%3D%22lingo-sub-1950447%22%20slang%3D%22en-US%22%3EVBA%20Excel%20Macro%20-%20Picture%20attached%20to%20Cell%20(insert)%20-%20Not%20link%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1950447%22%20slang%3D%22en-US%22%3E%3CP%3EI'm%20looking%20to%20simply%20run%20a%20macro%20that%20finds%20a%20picture's%20location%20in%20one%20cell%20and%20then%20insert%20the%20picture%20into%20another%20cell.%20But%20it%20has%20to%20be%20attached%20to%20a%20cell%20so%20it%20can%20be%20sorted%20AND%20be%20an%20actual%20picture%20vs%20a%20link.%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI've%20tried%202%20versions%20with%20each%20having%20it's%20own%20issues%3A%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E1%20-%20ActiveSheet.Pictures.Insert(picname).Select%20'%2C%20LinkToFile%3A%3DmsoFalse%2C%20SaveWithDocument%3A%3DmsoTrue%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E**%20This%20one%20attaches%20to%20cells%2C%20and%20inserts%20the%20pictures%2C%20but%20ONLY%20as%20links%2C%20so%20the%20spreadsheet%20can't%20be%20sent%20to%20anyone.%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E2%20-%20ActiveSheet.Shapes.AddPicture%20Filename%3A%3Dpicname%2C%20LinkToFile%3A%3DmsoFalse%2C%20SaveWithDocument%3A%3DmsoTrue%2C%20Left%3A%3DCells(CurRow%2C%20PicLocCol).Left%2C%20Top%3A%3DCells(CurRow%2C%20PicLocCol).Top%2C%20Height%3A%3D80%2C%20Width%3A%3D100%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E**%20This%20one%20attaches%20a%20picture%20(vs%20a%20link)%20and%20can%20be%20sent%2C%20but%20won't%20attach%20to%20cells%2C%20so%20it%20can't%20be%20sorted.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EPS%3A%20I%20don't%20know%20exactly%20how%20to%20attach%20code%2C%20so%20I'm%20attaching%20it%20as%20a%20DOC%20file.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EThe%20spreadsheet%20currently%20has%202%20columns.%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EB%20-%20C%3A%5Cpic1.jpg%3C%2FP%3E%3CP%3EA%20-%20C%3A%5Cpic2.jpg%3C%2FP%3E%3CP%3EC%20-%20C%3A%5Cpic3.jpg%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI%20added%20the%20letters%20in%20column%20A%20(out%20of%20order%20to%20test%20the%20sorting)%2C%20and%20a%20pic%20location%20in%20Column%20B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-1950447%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EMacros%20and%20VBA%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1953867%22%20slang%3D%22en-US%22%3ERe%3A%20VBA%20Excel%20Macro%20-%20Picture%20attached%20to%20Cell%20(insert)%20-%20Not%20link%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1953867%22%20slang%3D%22en-US%22%3E%3CP%3EI%20found%20a%20partial%20work%20around%20...%20but%20it's%20horrible%20to%20think%20this%20has%20to%20be%20done.%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EYou%20can%20use%20the%20first%20option%20to%20insert%20the%20pictures%20%2F%20attached%20to%20cells%20as%20links%2C%20then%20convert%20it%20to%20a%20PDF.%20The%20PDF%20can%20be%20sent%2C%20etc.%20Then%20convert%20it%20from%20PDF%20back%20to%20an%20Excel%20file.%20While%20this%20seems%20like%20a%20really%20bad%20work%20around%2C%20I%20haven't%20found%20any%20other%20options%20yet.%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1954114%22%20slang%3D%22de-DE%22%3ESubject%3A%20VBA%20Excel%20Macro%20-%20Picture%20attached%20to%20Cell%20(insert)%20-%20Not%20link%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1954114%22%20slang%3D%22de-DE%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F883953%22%20target%3D%22_blank%22%3E%40Gstg72%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%3CSPAN%20class%3D%22VIiyi%22%3E%3CSPAN%20class%3D%22JLqJ4b%20ChMk0b%22%3E%3CSPAN%3EI'm%20not%20sure%20if%20I%20understood%20it%20correctly%20from%20the%20translation%2C%20but%20I'm%20still%20sending%20you%20this%20VBA%20code%20with%20a%20selection%20function.%3C%2FSPAN%3E%3C%2FSPAN%3E%20%3CSPAN%20class%3D%22JLqJ4b%20ChMk0b%22%3E%3CSPAN%3EIf%20this%20is%20not%20what%20you%20had%20in%20mind%2C%20just%20ignore%20it.%3C%2FSPAN%3E%3C%2FSPAN%3E%26nbsp%3B%3C%2FSPAN%3E%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CPRE%20class%3D%22lia-code-sample%20language-applescript%22%3E%3CCODE%3EOption%20Explicit%0A%0A%0ASub%20InsertPicture()%0A%20Dim%20sPicture%20As%20String%2C%20pic%20As%20Picture%0A%0A%20sPicture%20%3D%20Application.GetOpenFilename%20_%0A%20(%22Pictures%20(*.gif%3B%20*.jpg%3B%20*.bmp%3B%20*.tif)%2C%20*.gif%3B%20*.jpg%3B%20*.bmp%3B%20*.tif%22%2C%20_%0A%20%2C%20%22Select%20Picture%20to%20Import%22)%0A%0A%20If%20sPicture%20%3D%20%22False%22%20Then%20Exit%20Sub%0A%0A%20Set%20pic%20%3D%20ActiveSheet.Pictures.Insert(sPicture)%0A%20With%20pic%0A%20.ShapeRange.LockAspectRatio%20%3D%20msoFalse%0A%20.Height%20%3D%20ActiveCell.Height%0A%20.Width%20%3D%20ActiveCell.Width%0A%20.Top%20%3D%20ActiveCell.Top%0A%20.Left%20%3D%20ActiveCell.Left%0A%20.Placement%20%3D%20xlMoveAndSize%0A%20End%20With%0A%0A%20Set%20pic%20%3D%20Nothing%0A%0A%20End%20Sub%3C%2FCODE%3E%3C%2FPRE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI%20would%20be%20happy%20to%20know%20if%20I%20could%20help.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3ENikolino%3C%2FP%3E%3CP%3EI%20know%20I%20don't%20know%20anything%20(Socrates)%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E*%20Kindly%20Mark%20and%20Vote%20this%20reply%20if%20it%20helps%20please%2C%20as%20it%20will%20be%20beneficial%20to%20more%20community%20members%20reading%20here.%3C%2FP%3E%3C%2FLINGO-BODY%3E
Occasional Contributor

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

5 Replies

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.

@Gstg72 

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.

@Nikolino 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. 

 

 

@Gstg72 

 

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)

After repeated translations with other software, I (I think) understood what you wanted. Do not think that this can be done with the file sent by me. Maybe only partly. Anyway, I wish you the best of luck and success in your project. Thank you, Nikolino I know that I don't know (Socrates)