User Form for view, inserting or changing a photo in a cell

[bisel]

Hello All,

I am a novice at writing efficient VBA code and hoping someone might be able to help me.

I have a workbook and would like to use the Excel capability to insert an image into a cell by having the user select an image located on their computer's hard drive somewhere. I like the idea of inserting an image into a cell because of the capability to retain sort order and filtering.

My concept is that the user would click to select a cell on the sheet and then give them the option to edit the image associated with that cell. If the user selects that option to edit the image, then have a user form open. Probably call the user form "Image Editor" or something like that. When the form initializes, I want the form to look like something like this ...

The User Form will initialize and show a preview of the current image associated with the cell that the user selects. The image will be in the cell not overlayed over the cell. Of course, if there is no image in the cell, merely show a blank. I then would think of having two control buttons to remove or replace the current image. My thought is that if there is no image in the cell, then the replace button would merely add one from a folder that the user would select. Lastly, the close the button would merely close the user form.

I know how to create simple user forms and understand the concept of initialize and activate events. Closing the form is no problem for me. What I need assistance with is how to create the VBA code so that when the user selects the component on the sheet, the form would initialize and show the preview of the currently associated image (if there is one).

Has anyone done anything like this? Can you point me in the right direction?

Thanks,

Steve

 

[Artik]

I focused too much on the NdNoviceHlp problem without reading the post with understanding. Without having a 365 version, you cannot use the InsertPictureInCell method. So you only need such code to insert an image into a cell (as long as you have 365):

Sub BBB()
    Dim wks As Worksheet
    Dim is365 As Boolean

    On Error Resume Next
    is365 = (Application.Evaluate("=LAMBDA(x, x^2)(2)") = 4)
    On Error GoTo 0

    If is365 Then
        Set wks = ActiveSheet

        With wks.Range("D2")
            .InsertPictureInCell "D:\Pictures\MyPicture.jpg"
        End With
    Else
        MsgBox "Unfortunately, you must have an Office 365 subscription", vbExclamation
    End If

End Sub

Artik

 

[bisel]

I was able to achieve the function I was looking for. Albeit not a super elegant solution, but workable.

First the structure of the workbook. The Excel workbook is an application to perform financial analysis. One of the sheets is used to enter physical components that a homeowner association is responsible for servicing. Each row of a table has the relative information for each component. A cell is reserved to allow the user to insert an image (picture) inside the cell. The advantage of inserting a picture inside the cell is to allow the table to sorted or filtering without losing the relationship the photo has to the physical component.

The user form opens when the user clicks on any cell in the “Component Photo Options” column.

Here is the VBA for the userform and command buttons:

The User Form:

Private Sub UserForm_activate()
Dim reprotect As Boolean
Dim rng As String
Dim excelVersion As Double
Dim Fname As String

'Check if Excel is at least version 2019 ...
    excelVersion = Application.version
    If excelVersion < 16 Then
        MsgBox "Your Excel version is older than 2019 and is not compatible with this version of the Reserve Funding Analyzer. Please upgrade Excel."
        Exit Sub
    Else
    End If

On Error Resume Next ' Comment this out for debugging

' turn off screen updating
    Application.ScreenUpdating = False

' If sheet is protected, unprotect it
    If ActiveSheet.ProtectContents = True Then
        ActiveSheet.Unprotect
        reprotect = True
    Else
        reprotect = False
    End If

' Get the photo cell address which is offsect by two columns from the active cell.  We will return to it later.
    rng = ActiveCell.Offset(0, 2).Address

' Change the caption of the component name on the user form
    Label1.Caption = ActiveCell.Offset(0, -15).Value

' Paste the component image into the merged cell, "photoview", to enlarge the image.  By copying the small cell into the larger merged cell, the image that is inside
'    the source cell (which is quite small) will be enlarged to fit inside the bounds of the merged cell.
    ActiveCell.Offset(0, 2).Copy 'This will be the cell with the photo, if one exists
    Sheet1.Range("photoview").Select ' The merged group of cells called "photoview" is about 8 rows high by 3 columns wide
    Sheet1.Paste ' Once pasted the photo inside the source cell will zoom to fill the area of the target cells.

' Select the range "photoview" and copy as picture and paste it with the name of "temppic".  The picture is named "temppic" so we can delete it later.
'  This operation is used to copy and paste the image into a chart.  A chart is used to "export" the chart image as a picture and save it in the home folder on the user's PC.
    Range("photoview").Select
    Selection.Copy
    Range("BI56").Select ' Select location removed from main part of sheet.  This is simple paste over cells versus inside cell.  The picture is named "temppic" so we can delete it later.
    Sheet1.Pictures.Paste.Name = "temppic"

' Create a new chart object.  The chart object is used as a target to paste the tempic over it, then export the chart as a picture.
    Sheet1.Shapes.AddChart2(201, xlColumnClustered).Name = "newchart"
    Sheet1.ChartObjects("newchart").Top = 900 'Select location removed from main part of sheet
    Sheet1.ChartObjects("newchart").Left = 2400
    Sheet1.ChartObjects("newchart").Height = 175 ' Choose reasonable size
    Sheet1.ChartObjects("newchart").Width = 250

' Paste the temp photo into the new chart
    Sheet1.Shapes.Range(Array("temppic")).Select
    Selection.Copy
    Sheet1.ChartObjects("newchart").Select
    ActiveChart.Paste
        
' Export the chart and save as BMP file
    Set CurrentChart = Sheet1.ChartObjects("newchart").Chart
    Fname = ThisWorkbook.Path & "\temp.bmp"
    CurrentChart.Export Filename:=Fname, FilterName:="BMP"

' Copy the BMP file and paste into the image location on the user form
    itemphoto.Image1.Picture = LoadPicture(Fname)
    itemphoto.Image1.PictureSizeMode = fmPictureSizeModeZoom
        
' Delete the new chart and the photo image from the worksheet and clear contents of the range, "photoview"
    Sheet1.Shapes.Range(Array("temppic")).Delete
    Sheet1.ChartObjects("newchart").Delete
    Sheet1.Range("photoview").ClearContents
    
' Delete the temp file picture on the user's PC if it exists
    If Dir(Fname) <> "" Then
        Kill Fname
    Else
    End If
    
' Turn screen updating back on
    Application.ScreenUpdating = True

'Reprotect the sheet if it was originally protected
    If reprotect = True Then
        ActiveSheet.Protect
        ActiveSheet.EnableSelection = xlUnlockedCells
        ActiveSheet.ProtectionButton.Caption = "Sheet Protected Click to Unprotect" ' This is optional to change color and caption of command button
        ActiveSheet.ProtectionButton.BackColor = RGB(0, 155, 0)
    Else
        ActiveSheet.ProtectionButton.Caption = "Sheet UnProtected Click to Protect" ' This is optional to change color and caption of command button
        ActiveSheet.ProtectionButton.BackColor = RGB(255, 0, 0)
    End If

' Go back to the rng address and select the cell
    Range(rng).Select ' Don't want to select the indicator cell as that would trigger the change event.

' Turn screen updating back on
    Application.ScreenUpdating = True

End Sub

The Change Photo Command Button

Private Sub ChangePhotoButton_Click()
Dim filePath As String
Dim reprotect As Boolean

On Error Resume Next ' Comment this out for degugging

' If sheet is protected, unprotect it
    If ActiveSheet.ProtectContents = True Then
        ActiveSheet.Unprotect
        reprotect = True
    Else
        reprotect = False
    End If
    
' Prompt the user to select an image file
    filePath = Application.GetOpenFilename("Image Files,*.jpg;*.jpeg;*.png;*.gif;*.bmp", , "Select an Image File")
    
' Check if the user canceled the file dialog
    If filePath = "False" Then
        MsgBox "No file selected."
    Else
'        MsgBox "You selected: " & filePath
' You can add your code here to handle the selected file
    ActiveCell.InsertPictureInCell (filePath)
    End If

 Unload itemphoto ' Close the user form

' Change the active cell to the column with the photo indicator entries.  This will trigger the change event and open the user form and run the initialize event to refresh the userform.
    ActiveCell.Offset(0, -2).Select ' The active call at this point is the cell containing the photo.  The trigger cell will be two columns to the left.
    
'Reprotect the sheet if it was protected originally
    If reprotect = True Then
        ActiveSheet.Protect
        ActiveSheet.EnableSelection = xlUnlockedCells
        ActiveSheet.ProtectionButton.Caption = "Sheet Protected Click to Unprotect"  ' This is optional to change color and caption of command button
        ActiveSheet.ProtectionButton.BackColor = RGB(0, 155, 0)
    
      Else
        ActiveSheet.ProtectionButton.Caption = "Sheet UnProtected Click to Protect"  ' This is optional to change color and caption of command button
        ActiveSheet.ProtectionButton.BackColor = RGB(255, 0, 0)
        
    End If
    
End Sub

The Remove Photo Command Button

Private Sub RemovePhotoButton_Click()
Dim reprotect As Boolean

On Error Resume Next ' Comment this out for degugging

' If sheet is protected, unprotect it
    If ActiveSheet.ProtectContents = True Then
        ActiveSheet.Unprotect
        reprotect = True
    Else
        reprotect = False
    End If

    ActiveCell.ClearContents ' If this button is selected, delete the image from the sheet.
    Unload itemphoto ' Close the user form
    ActiveCell.Offset(0, -2).Select 'Trigger change event and open the userform again with refresh and the previous image should not be shown now.

'Reprotect the sheet if it was protected originally
    If reprotect = True Then
        ActiveSheet.Protect
        ActiveSheet.EnableSelection = xlUnlockedCells
        ActiveSheet.ProtectionButton.Caption = "Sheet Protected Click to Unprotect"  ' This is optional to change color and caption of command button
        ActiveSheet.ProtectionButton.BackColor = RGB(0, 155, 0)
      Else
        ActiveSheet.ProtectionButton.Caption = "Sheet UnProtected Click to Protect"  ' This is optional to change color and caption of command button
        ActiveSheet.ProtectionButton.BackColor = RGB(255, 0, 0)
    End If

End Sub

 

[Artik]

Are you sure that the 2019+ versions allow you to use InsertPictureInCell? Because it seems to me that only 365.

Artik

 

[bisel]

Are you sure that the 2019+ versions allow you to use InsertPictureInCell? Because it seems to me that only 365.

Artik

 

[NdNoviceHlp]

I have 2019, 2021 and 2024... I think only 365 has this option. Thanks for posting your outcome. Dave

 

[bisel]

I am not certain at all. When I performed a search online, I received indication that the insert picture inside a cell is available as a function in Excel 16.0.13029.20344 ... which is Excel 2019. But I have also seen an Microsoft functionality release statement indicating that the IMAGE function is made available beginning with Version 2209 (Build 15608.10000) or later ... which is Excel 365. But the IMAGE function is for pictures on the Web where the picture is rendered inside a cell.

Refer to this MS link ... Insert Picture in-cell in Excel - Microsoft Support

 

[Micron]

Because it seems to me that only 365.

I have 365 and as far as I can tell the version is 2016, and I don't seem to have this feature. At least not via the ribbon as explained in the linked page.

 

[Artik]

Bisel, I asked for a reason. In your code there is a condition

'Check if Excel is at least version 2019 ...
    excelVersion = Application.Version
    If excelVersion < 16 Then
        MsgBox "Your Excel version is older than 2019 and is not compatible with this version of the Reserve Funding Analyzer. Please upgrade Excel."
        Exit Sub
    Else
    End If

that checks if Excel is a version higher than 2013. And you should be talking about checking if it's 365 (because it's the only one on which inserting an picture into a cell works). So far, the 2019+ and 365 versions have a code version of “16.0”. In addition, there is no simple method to check the version. That's why I suggested in post No. 11 to use the LAMBDA function, which is only available in 365, to check whether it's actually 365.
Now I would write this code even differently, because ultimately we are interested in whether you can insert an image into a cell.

Sub CCC()
    Dim wks As Worksheet

    Set wks = ActiveSheet

    On Error Resume Next
    wks.Range("D2").InsertPictureInCell "D:\Pictures\MyPicture.jpg"
   
    If Err.Number <> 0 Then
        MsgBox "Unfortunately, your version of Excel does not support inserting an picture into a cell.", vbExclamation
    End If
    On Error GoTo 0
   
End Sub

Also, remember that Application.Version returns a text value. It's almost a coincidence that assigning text to a variable of type Double in your case worked. In my case, there is no chance for this part to work. That's why you should use the Val function in addition to it to make the code work in all language versions:

If Val(Application.Version) < 16 Then

Micron, I have a request for you to check if the CCC macro will work. If you get an unpleasant message, please specify what version of 365 you have.

NdNoviceHlp, I am working on code that will work similarly to InsertPictureInCell (for versions other than 365), but it will certainly be much more complex than this simple instruction.

Artik

 

[Micron]

I get error 438 - Object doesn't support this property or method

version (I turned off updates long ago)

 

[Artik]

Rather, I was thinking about whether you have a Personal, a Family, or maybe one of the Business versions. But it's not out of the question that it's not any of those versions, it's just that you don't have an updated version of Office.

Artik