UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Insert Images Into Cells Based On Hyperlink Column, Office 2010    
 
   
baffled100
post Jul 17 2017, 10:25 AM
Post#1



Posts: 320
Joined: 10-December 12



Hi,

I have an Excel spreadsheet that has a column with hyperlinks to image files in one column. I'd like to insert the actual images into a separate column in the spreadsheet. I found a way to do it by inserting a comment and "filling" the background of the comment with the image. But that is not ideal, nor automatic. I'd like to be able to run a macro that that insert the images into the file, but I am not good with VBA. I haven't been able to understand other examples I've found on the web.

Thank you!!
Go to the top of the page
 
ADezii
post Jul 17 2017, 07:10 PM
Post#2



Posts: 1,682
Joined: 4-February 07
From: USA, Florida, Delray Beach


  1. First of all. I am assuming that all of your Graphic Files are small (such as Logos) and of the same Dimensions.
  2. I am also assuming that the Graphic Files will be inserted into Column D of the corresponding Hyperlinks.
  3. The process would be as follows:
    1. Define your Range containing the Hyperlinks (for this Demo - Worksheets("Sheet1").Range("A1:A20")).
    2. Loop thru every Cell within the Hyperlink Range.
    3. Select Column D in the same Row as the found Hyperlink.
    4. Apply the Insert Method to the Cell in Column D.
    5. Insert the actual Graphic as reflected by the Value Property of the Cells in the Range A1:A20.
    6. Scale the Width and Height of the Graphic, if necessary, being sure to anchor the Top Left Corner. You will need to define your own Scaling Factor (in this Demo I used .2).
  4. Code Definition:
    CODE
    Dim rng1 As Excel.Range
    Dim rng2 As Excel.Range

    Set rng1 = ActiveWorkbook.Worksheets("Sheet1").Range("A1:A20")

    For Each rng2 In rng1
      With rng2
        If rng2 <> "" Then
          .Offset(0, 2).Select
          .Offset(0, 2).Insert
           ActiveSheet.Pictures.Insert(.Value).Select
        
          Selection.ShapeRange.ScaleWidth 0.2, msoFalse, msoScaleFromTopLeft
          Selection.ShapeRange.ScaleHeight 0.2, msoFalse, msoScaleFromTopLeft
        End If
      End With
    Next
  5. This Code has only been tested minimally, but appears to have promise. I'll let you take it from here smile.gif .
  6. Hope this helps.

This post has been edited by ADezii: Jul 17 2017, 07:11 PM
Go to the top of the page
 
baffled100
post Jul 19 2017, 03:33 PM
Post#3



Posts: 320
Joined: 10-December 12



Thanks so much for your reply!! I haven't had a chance to try this yet, but will very soon. I'll post if I have luck or not....thanks again!
Go to the top of the page
 
ADezii
post Jul 19 2017, 05:00 PM
Post#4



Posts: 1,682
Joined: 4-February 07
From: USA, Florida, Delray Beach


yw.gif
Go to the top of the page
 


Custom Search
RSSSearch   Top   Lo-Fi    28th July 2017 - 06:07 AM