Adding and Assigning Photos

overKBV

New Member
Joined
Sep 15, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
I have an asset list of 200+ items. I would like to add photos of each asset to its row. So far I have this command button vba
VBA Code:
Private Sub AddPicture_Click()
    Dim strFileName As String
    Dim objPic As Picture
    Dim rngDest As Range
    strFileName = Application.GetOpenFilename( _
        FileFilter:="Images (*.jpg;*.gif;*.png),*.jpg;*.gif;*.png", _
        Title:="Please select an image...")
    If strFileName = "False" Then Exit Sub
    Set rngDest = Me.Range("A10:D20")
    Set objPic = Me.Pictures.Insert(strFileName)
    With objPic
        .ShapeRange.LockAspectRatio = msoFalse
        .Left = rngDest.Left
        .Top = rngDest.Top
        .Width = rngDest.Width
        .Height = rngDest.Height
    End With
End Sub
I need to be able to restrict the photo to the individual cell and be able to repeat the button for each asset. Ideally I would be able to search for the asset and then click add photo.
Any help or direction to other resources would be appreciated.
Thanks
P.S. I did not write the code above so please don't overestimate my ability I have the most basic understanding of any of this.
 

Attachments

  • Asset.png
    Asset.png
    14.1 KB · Views: 5

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

KOKOSEK

Active Member
Joined
Apr 8, 2019
Messages
420
Office Version
  1. 365
  2. 2013
Platform
  1. Windows
This (I've done some changes) gives you opportunity to insert picture to activecell with the same button.
So select cell where you want to put picture and run it:

VBA Code:
Sub AddPicture_Click()
    Dim strFileName As String
    Dim objPic As Picture
    Dim rngDest As Range
    strFileName = Application.GetOpenFilename( _
        FileFilter:="Images (*.jpg;*.gif;*.png),*.jpg;*.gif;*.png", _
        Title:="Please select an image...")
    If strFileName = "False" Then Exit Sub
    Set rngDest = ActiveCell
    Set objPic = ActiveSheet.Pictures.Insert(strFileName)
    With objPic
        .ShapeRange.LockAspectRatio = msoFalse
        .Left = rngDest.Left + 1
        .Top = rngDest.Top + 1
        .Width = rngDest.Width - 2
        .Height = rngDest.Height - 2
    End With
End Sub

to be honest I do not see reason to create separate buttons for each individual row/product/record.
 
Solution

overKBV

New Member
Joined
Sep 15, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
This (I've done some changes) gives you opportunity to insert picture to activecell with the same button.
So select cell where you want to put picture and run it:

VBA Code:
Sub AddPicture_Click()
    Dim strFileName As String
    Dim objPic As Picture
    Dim rngDest As Range
    strFileName = Application.GetOpenFilename( _
        FileFilter:="Images (*.jpg;*.gif;*.png),*.jpg;*.gif;*.png", _
        Title:="Please select an image...")
    If strFileName = "False" Then Exit Sub
    Set rngDest = ActiveCell
    Set objPic = ActiveSheet.Pictures.Insert(strFileName)
    With objPic
        .ShapeRange.LockAspectRatio = msoFalse
        .Left = rngDest.Left + 1
        .Top = rngDest.Top + 1
        .Width = rngDest.Width - 2
        .Height = rngDest.Height - 2
    End With
End Sub

to be honest I do not see reason to create separate buttons for each individual row/product/record.
It works thank you!
 

KOKOSEK

Active Member
Joined
Apr 8, 2019
Messages
420
Office Version
  1. 365
  2. 2013
Platform
  1. Windows
Happy to hear it.
You have to remember that ActiveSheet.Pictures.Insert(strFileName) just inserting picture into excel (link them) and if you want to use this excel on another computer, picture won't be visible.
If you want to see these picture on each computer you can use this (main change is to use Shapes.AddPicture instaed)

VBA Code:
Sub AddPictureNotInsert()
    Dim strFileName As String
    Dim objPic As Shape
    Dim rngDest As Range
    strFileName = Application.GetOpenFilename( _
        FileFilter:="Images (*.jpg;*.gif;*.png),*.jpg;*.gif;*.png", _
        Title:="Please select an image...")
    If strFileName = "False" Then Exit Sub
    Set rngDest = ActiveCell
    Set objPic = ActiveSheet.Shapes.AddPicture(strFileName, False, True, 10, 10, -1, -1)
    With objPic
        .LockAspectRatio = msoFalse
        .Left = rngDest.Left + 1
        .Top = rngDest.Top + 1
        .Width = rngDest.Width - 2
        .Height = rngDest.Height - 2
    End With
End Sub
 

overKBV

New Member
Joined
Sep 15, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Happy to hear it.
You have to remember that ActiveSheet.Pictures.Insert(strFileName) just inserting picture into excel (link them) and if you want to use this excel on another computer, picture won't be visible.
If you want to see these picture on each computer you can use this (main change is to use Shapes.AddPicture instaed)

VBA Code:
Sub AddPictureNotInsert()
    Dim strFileName As String
    Dim objPic As Shape
    Dim rngDest As Range
    strFileName = Application.GetOpenFilename( _
        FileFilter:="Images (*.jpg;*.gif;*.png),*.jpg;*.gif;*.png", _
        Title:="Please select an image...")
    If strFileName = "False" Then Exit Sub
    Set rngDest = ActiveCell
    Set objPic = ActiveSheet.Shapes.AddPicture(strFileName, False, True, 10, 10, -1, -1)
    With objPic
        .LockAspectRatio = msoFalse
        .Left = rngDest.Left + 1
        .Top = rngDest.Top + 1
        .Width = rngDest.Width - 2
        .Height = rngDest.Height - 2
    End With
End Sub
Is there a way to permalink them? It is all in OneDrive if that would fix it?
 

overKBV

New Member
Joined
Sep 15, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Is there a way to permalink them? It is all in OneDrive if that would fix it?
Also is there a way to link an object with the file location of the picture so when I clicked on the photo it could direct me to that picture in file explorer? Again, you have been very helpful thanks!
 

KOKOSEK

Active Member
Joined
Apr 8, 2019
Messages
420
Office Version
  1. 365
  2. 2013
Platform
  1. Windows

ADVERTISEMENT

Code from post #4 (AddPictureNotInsert) do the job. Pictures will be permanently embed and keep inside xl file.
 

overKBV

New Member
Joined
Sep 15, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Code from post #4 (AddPictureNotInsert) do the job. Pictures will be permanently embed and keep inside xl file.
That works. I do not know if you saw my reply to myself so I'll post it again. No pressure. But I would like to be able to take that photo and copy and paste it into a word doc but to get it to fit in the cell it has to be shrunk. Do you know of a way I can link the file location so when I click on or near the photo is would then open it in file explorer or photos. Again appreciate your help.
 

KOKOSEK

Active Member
Joined
Apr 8, 2019
Messages
420
Office Version
  1. 365
  2. 2013
Platform
  1. Windows
Add this line:
VBA Code:
ActiveSheet.Hyperlinks.Add Anchor:=objPic, Address:=strFileName
before End Sub, so end of code should looks like this:

Code:
.....................
        .Width = rngDest.Width - 2
        .Height = rngDest.Height - 2
    End With
    ActiveSheet.Hyperlinks.Add Anchor:=objPic, Address:=strFileName
End Sub
then after inserting picture it will be clickable link into explorer.
I do not get this part with repasting it into word.
 

overKBV

New Member
Joined
Sep 15, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
It does what I need it to do. Thanks a bunch
 

Forum statistics

Threads
1,147,497
Messages
5,741,502
Members
423,662
Latest member
Ajmal Khursand

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top