Forum Discussion

Gstg72's avatar
Gstg72
Copper Contributor
Dec 02, 2020

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

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

9 Replies

  • audeser's avatar
    audeser
    Copper Contributor

    Gstg72 

    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):

    1. Use the inserted cell as a sorting index
    2. Use an inside text as reference (you can hide the text with the transparency value)
    3. Use the AlternativeText as reference (commented code)
    4. Use the Hyperlink (commented code)
    5. ... others to explore

    All the alternatives you have are marked with the '!!!!! alternative  tag, so you can choose which one better fits your needings.

    Kind regards

    • audeser's avatar
      audeser
      Copper Contributor
      Instead of going with the 4 alternatives I explored on my previous post, you can solve the sorting issue:
      Force the images to be inserted in an independent worksheet (inside the workbook), that can be hidden by default.
      Once the images are inserted, you could recall them from the cell content (as they are now "inmune" to the sort) with a trick like the one exposed on the Show_pics_no_VBA.xlsx found at: https://onedrive.live.com/view.aspx?cid=863b7dd7364138ec&page=view&resid=863B7DD7364138EC!419
      Obviously, you will need a "relation table" to keep track of the image index relation, but could be embedded on your main table just adding the index of the picture in an offset column
      Kind regards
      • NikolinoDE's avatar
        NikolinoDE
        Gold Contributor
        If you query OneDrive about the path of the file it says something like C: usersNameOneDrive.
        However, if you query the path in the file using a macro, it will give you a path with https: //d.docs.live.net / ....
        If this is your case, then ...
        To solve it, you could try by deactivating the "Update while opening" option in the OneDrive settings.
        In this way, however, it would no longer be possible to work on one document at the same time.

        Here I am at the end of my game ... I can't help anymore.
        My experiences with OneDrive, Sharepoints and OnLine Excel are still in the beginning

        Thank you for your patience and understanding

        Nikolino
  • NikolinoDE's avatar
    NikolinoDE
    Gold Contributor
    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)
  • NikolinoDE's avatar
    NikolinoDE
    Gold Contributor

    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.

    • Gstg72's avatar
      Gstg72
      Copper Contributor

      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. 

       

       

      • NikolinoDE's avatar
        NikolinoDE
        Gold Contributor

        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)

  • Gstg72's avatar
    Gstg72
    Copper Contributor

    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.

    • alyshap2012's avatar
      alyshap2012
      Copper Contributor

      Gstg72 did you ever find a fix to this? I am trying to have a visible file inserted from a path, but im not great at coding for excel or using it yet. I've used it for years but only recently learned some of what you're able to do. I've taken SQL classes, but I still have no clue what im doing. The few things i've tried did not work. I dont need to sort mine, I just need a visible image inserted in place of file paths already inserted into the spreadsheet, OR I need them inserted in a column next to. BUT, I have multiple images for each item in a row, so I'm not sure if i would need to add additional columns or additional rows. But I know I need the actual image in the spreadsheet. There are a few thousand, so I do NOT want to have to do it all manually if I can avoid it. I wrote a code to retrieve the images and it took months to get it right, but I don't have that kind of time for this. Ive tried ablebits and I just get errors. I've tried a macros code or two and got errors with that as well. 😕

      If you have any suggestions i'd love to hear them. If you need any specific or additional info just let me know!

       

Resources