VBA to add/change loaded ´Picture´ of an Image within a UserForm

[novabond]

Hello.

I need to create a UserForm template, which includes 5 images, these images will eventually have pdf pictures loaded.

I will then need to creating about 30+ UserForms from this template, i can do this manually by importing the template and renaming it, and I know i can then go into each UserForm, and load Image pictures myself but, I wondered if there was code i could use, which would automatically do it for me, saving me time.

I am grateful to anyone who fancies having a go... we could start perhaps with these details

UserFormTEMP	UserFormNEW1	UserFormNEW2
loaded:	load:	load:
Image1 - c:\excel\pictures\fileone.jpg	Image1 - c:\excel\pictures\file1one.jpg	Image1 - c:\excel\pictures\file2one.jpg
Image2 - c:\excel\pictures\filetwo.jpg	Image2 - c:\excel\pictures\file1two.jpg	Image2 - c:\excel\pictures\file2two.jpg
Image3 - c:\excel\pictures\filethree.jpg	Image3 - c:\excel\pictures\file1three.jpg	Image3 - c:\excel\pictures\file2three.jpg
Image4 - c:\excel\pictures\filefour.jpg	Image4 - c:\excel\pictures\file1four.jpg	Image4 - c:\excel\pictures\filefour.jpg
Image5 - c:\excel\pictures\filefive.jpg	Image5 - c:\excel\pictures\file1five.jpg	Image5 - c:\excel\pictures\file2five.jpg

btw. i would not need to have files loaded to pictures in the images of the Template UserForm, i have only included them above in case, that makes a difference.

another idea i had but, i think this is maybe imposible, is for ever image to have there own CommandButton, which runs code that will change/update the Image Picture file, to the file name that the user can enter when prompted. But as i say, thought the research i have done today looking for existing code, It seems making the change stick around, i.e. even when the file location changes, isnt a simple thing to do... or maybe i am wrong?

Here is the best thread/code i have found to date, that i can adapt

VBA - change image UserForm

Hi guys, I have inserted some images in the UserForm and I would like them to change depending on the checkbox I check. Do you think it is possible to do such a thing? Max

www.mrexcel.com

but, wondered if someone could suggest code, that would do more what i want straight away.

thanks in advance!

Best
Bebe

 

[bobsan42]

I would suggest you do some further thinking before creating 30+ similar userforms.
If there is no fundamental difference between the separate forms - you can design 1 form and create a new instance every time you need it.

Set UserFormNEW1 = VBA.UserForms.Add("UserFormTEMP")
UserFormNEW1.context = "A1" 'just a n example
UserFormNEW1.show

Include a variable/property to distinguish between the forms and their context.
Then based on the value of the variable you can load a predefined or properly named set of images to each control:
sample code in the userform module:

Option Explicit

Private pContext  As String
Private Const imgPath = "C:\images\"

Property Let context(ByVal formContext As String)
    pContext = formContext
    setImages
End Property

Private Sub setImages()
    Dim i As Long
    Dim iName As String
    For i = 1 To 5
        iName = imgPath & "image" & pContext & i
        Me.Controls("Image" & i).Picture = LoadPicture(iName)
    Next i
    Repaint
End Sub

Based on the value of pContext you can run different codes if necessary.
This is how I would do it.
Maintaining the code in 30+ forms is a tedious task and prone to a lot of errors, even if you use classes and advanced coding techniques.
Tracking the images location on each machine is also a big problem, but saving a lot of images with your code and forms is far from the best solution. Below are a few possibilities:

1. one way is to have them all in a fixed location on every machine
2. have them all in a shared network location, accessible for everyone (best, if feasible; easy to maintain or change)
3. have them all in a folder next to the workbook with the code (thisworkbook.path & application.pathseparator & "imgFolder\")

 

[MicCh]

Dim myUserForms As Collection
Dim myPictures As Collection
Dim ufmName As String
Dim fdPth As String
Dim fName As String
    
Private Sub ComboBox1_Change()
    Dim index0 As Integer
    ufmName = Me.ComboBox1.Text
    Set myPictures = myUserForms.Item(ufmName)
    Me.TextBox1.Text = myPictures("FolderPath")
    With Me.ListBox1
        .Clear
        For index0 = 1 To 5
            .AddItem myPictures.Item(VBA.CStr(index0))
        Next
    End With
End Sub

Private Sub ListBox1_Click()
    Dim index0 As Integer
    Dim picPath As String
    index0 = ListBox1.ListIndex
    If index0 >= 0 Then
        picPath = TextBox1.Text & ListBox1.List(index0)
        Me.Image1.Picture = LoadPicture(picPath)
    End If
End Sub

Private Sub UserForm_Initialize()
    Dim iRow As Long, iColumn As Long
    Set myUserForms = New Collection
    With Sheet1
        For iRow = 3 To 5
            ufmName = .Cells(iRow, 2).Value
            If VBA.Len(ufmName) > 0 Then
                Set myPictures = New Collection
                fdPth = .Cells(iRow, 3).Value
                myPictures.Add fdPth, "FolderPath"
                For iColumn = 4 To 8
                    fName = .Cells(iRow, iColumn).Value
                    myPictures.Add fName, VBA.CStr(iColumn - 3)
                Next
                myUserForms.Add myPictures, ufmName
                Me.ComboBox1.AddItem ufmName
            End If
        Next
    End With
End Sub

 

[novabond]

View attachment 103341

Dim myUserForms As Collection
Dim myPictures As Collection
Dim ufmName As String
Dim fdPth As String
Dim fName As String
   
Private Sub ComboBox1_Change()
    Dim index0 As Integer
    ufmName = Me.ComboBox1.Text
    Set myPictures = myUserForms.Item(ufmName)
    Me.TextBox1.Text = myPictures("FolderPath")
    With Me.ListBox1
        .Clear
        For index0 = 1 To 5
            .AddItem myPictures.Item(VBA.CStr(index0))
        Next
    End With
End Sub

Private Sub ListBox1_Click()
    Dim index0 As Integer
    Dim picPath As String
    index0 = ListBox1.ListIndex
    If index0 >= 0 Then
        picPath = TextBox1.Text & ListBox1.List(index0)
        Me.Image1.Picture = LoadPicture(picPath)
    End If
End Sub

Private Sub UserForm_Initialize()
    Dim iRow As Long, iColumn As Long
    Set myUserForms = New Collection
    With Sheet1
        For iRow = 3 To 5
            ufmName = .Cells(iRow, 2).Value
            If VBA.Len(ufmName) > 0 Then
                Set myPictures = New Collection
                fdPth = .Cells(iRow, 3).Value
                myPictures.Add fdPth, "FolderPath"
                For iColumn = 4 To 8
                    fName = .Cells(iRow, iColumn).Value
                    myPictures.Add fName, VBA.CStr(iColumn - 3)
                Next
                myUserForms.Add myPictures, ufmName
                Me.ComboBox1.AddItem ufmName
            End If
        Next
    End With
End Sub

hi MicCh... thank you so much for this! it works great.... and as the images are alraedy listed on a register, it was simple for me to set up... I will do another thread regarding some tweeks ( i would llike to add a couple of text box linked to more register coloums but, can´t quite get it right adapting the code myself... ) however, I do have another question before i can close this thread, and regarding your solution, I don´t supose you know:

is there a
file size restriction to the
picture file selected for
Image1 in ListBox1
?

As the code worked fine for me when i first set it up and tested using JPG File 378 KB, but gives me a run time error when i swap the image (same file name and path) for JPEG FILE 1.079 KB.

note: i went through alot of contoled trial and error myself, trying to work out what was causing the issue, origianlly I thoght it was perhaps to do with my jpg files having long file names and paths, also including the underscore _ character but, proved that wasnt the issue but, if the only difference is the file size, i get Run-time error '-2147467259 (80004005)': Automation error Unspecified error, I did try googling this error however, the language witin the informaion i found, was far to advanced for me to grasp.

Thank you so much, if you cann help with this issue otherwise, not to worry, thanks so much anyhow!, and i will look into making my jpgs smaller, and mark this thread as solved.

Bebe

 

[novabond]

I would suggest you do some further thinking before creating 30+ similar userforms.
If there is no fundamental difference between the separate forms - you can design 1 form and create a new instance every time you need it.

Set UserFormNEW1 = VBA.UserForms.Add("UserFormTEMP")
UserFormNEW1.context = "A1" 'just a n example
UserFormNEW1.show

Include a variable/property to distinguish between the forms and their context.
Then based on the value of the variable you can load a predefined or properly named set of images to each control:
sample code in the userform module:

Option Explicit

Private pContext  As String
Private Const imgPath = "C:\images\"

Property Let context(ByVal formContext As String)
    pContext = formContext
    setImages
End Property

Private Sub setImages()
    Dim i As Long
    Dim iName As String
    For i = 1 To 5
        iName = imgPath & "image" & pContext & i
        Me.Controls("Image" & i).Picture = LoadPicture(iName)
    Next i
    Repaint
End Sub

Based on the value of pContext you can run different codes if necessary.
This is how I would do it.
Maintaining the code in 30+ forms is a tedious task and prone to a lot of errors, even if you use classes and advanced coding techniques.
Tracking the images location on each machine is also a big problem, but saving a lot of images with your code and forms is far from the best solution. Below are a few possibilities:

1. one way is to have them all in a fixed location on every machine
2. have them all in a shared network location, accessible for everyone (best, if feasible; easy to maintain or change)
3. have them all in a folder next to the workbook with the code (thisworkbook.path & application.pathseparator & "imgFolder\")

Hi Bobsan42, thank for helping... I really like the concept of your code but, I could´nt quite work out how to set it up.... I did try but, i dont really know where to place 'Option Explicit' or 'Priviate Sub'and how to get things to run without them relating to a 'Sub myname ()' if that makes sense... I think however, the logic is the very similar in both the replys i got so, perfct solution!... with that in mind though, and as you have written the code already, and if its not too much trouble, it would be great if you coudl expand on how i woud set up the userForm and where i coud place the code in order to get it to run... if that makes sense... as I think i got close, and would love to be able to see it in action... But, either way, thanks again for your help, it was greatly apriaciated!
Bebe

 

[nepakumar]

I would suggest you do some further thinking before creating 30+ similar userforms.
If there is no fundamental difference between the separate forms - you can design 1 form and create a new instance every time you need it.

Set UserFormNEW1 = VBA.UserForms.Add("UserFormTEMP")
UserFormNEW1.context = "A1" 'just a n example
UserFormNEW1.show

Include a variable/property to distinguish between the forms and their context.
Then based on the value of the variable you can load a predefined or properly named set of images to each control:
sample code in the userform module:

Option Explicit

Private pContext  As String
Private Const imgPath = "C:\images\"

Property Let context(ByVal formContext As String)
    pContext = formContext
    setImages
End Property

Private Sub setImages()
    Dim i As Long
    Dim iName As String
    For i = 1 To 5
        iName = imgPath & "image" & pContext & i
        Me.Controls("Image" & i).Picture = LoadPicture(iName)
    Next i
    Repaint
End Sub

Based on the value of pContext you can run different codes if necessary.
This is how I would do it.
Maintaining the code in 30+ forms is a tedious task and prone to a lot of errors, even if you use classes and advanced coding techniques.
Tracking the images location on each machine is also a big problem, but saving a lot of images with your code and forms is far from the best solution. Below are a few possibilities:

1. one way is to have them all in a fixed location on every machine
2. have them all in a shared network location, accessible for everyone (best, if feasible; easy to maintain or change)
3. have them all in a folder next to the workbook with the code (thisworkbook.path & application.pathseparator & "imgFolder\")

Hi Bobsan42, thank for helping... I really like the concept of your code but, I could´nt quite work out how to set it up.... I did try but, i dont really know where to place 'Option Explicit' or 'Priviate Sub'and how to get things to run without them relating to a 'Sub myname ()' if that makes sense... I think however, the logic is the very similar in both the replys i got so, perfct solution!... with that in mind though, and as you have written the code already, and if its not too much trouble, it would be great if you coudl expand on how i woud set up the userForm and where i coud place the code in order to get it to run... if that makes sense... as I think i got close, and would love to be able to see it in action... But, either way, thanks again for your help, it was greatly apriaciated!
Bebe

I would suggest you do some further thinking before creating 30+ similar userforms.
If there is no fundamental difference between the separate forms - you can design 1 form and create a new instance every time you need it.

Set UserFormNEW1 = VBA.UserForms.Add("UserFormTEMP")
UserFormNEW1.context = "A1" 'just a n example
UserFormNEW1.show

Include a variable/property to distinguish between the forms and their context.
Then based on the value of the variable you can load a predefined or properly named set of images to each control:
sample code in the userform module:

Option Explicit

Private pContext  As String
Private Const imgPath = "C:\images\"

Property Let context(ByVal formContext As String)
    pContext = formContext
    setImages
End Property

Private Sub setImages()
    Dim i As Long
    Dim iName As String
    For i = 1 To 5
        iName = imgPath & "image" & pContext & i
        Me.Controls("Image" & i).Picture = LoadPicture(iName)
    Next i
    Repaint
End Sub

Based on the value of pContext you can run different codes if necessary.
This is how I would do it.
Maintaining the code in 30+ forms is a tedious task and prone to a lot of errors, even if you use classes and advanced coding techniques.
Tracking the images location on each machine is also a big problem, but saving a lot of images with your code and forms is far from the best solution. Below are a few possibilities:

1. one way is to have them all in a fixed location on every machine
2. have them all in a shared network location, accessible for everyone (best, if feasible; easy to maintain or change)
3. have them all in a folder next to the workbook with the code (thisworkbook.path & application.pathseparator & "imgFolder\")

I used Bobsan42's code but the Userform Image control simply doesnt load the image. The code compiles without issues. The file path and the file name are valid and correct. (I Debug.Printed).
I have a shape on the worksheet named "_A1".
The code in the Standard module is:
Sub test1()
With New UserForm1
.context = Application.Caller
UserForm1.Show
End With
End Sub

The code in the Userform is:
Private Sub setImages()
Dim imgPath As String
Dim iName As String
imgPath = ThisWorkbook.Path
iName = imgPath & Application.PathSeparator & pContext & ".jpg"
'Debug.Print iName
Me.Image1.Picture = LoadPicture(iName)
Repaint
End Sub

The form shows up with the blank image control.

 

[bobsan42]

Here is an zipped example of a form/code which loads images from subfolders .
It became a bit messy, but it works.


buildForm() allows starting several instances of the same form
uf.context = "Some valid folder name" allows to load images from different folders, so each instance of the form can show different images
there is a combobox to show dynamic image loading from different folders.

Basically what you need is a form called UserForm1 (size 400 x 400 for example) and a code module.
on the user form there is a Combobox1 (to show a list of the available folders), Label1(just says Select folder), Label2 (show number of files and size of the selected folder), CommandButton1 (used as a Cancel/Close button):
The code in the User form:

Option Explicit

Private pContext  As String
Private Const IMGNAMEPREFIX = "image"
Private Const IMGSPACE As Single = 5.5
Private Const IMGWIDTH As Single = 90
Private Const IMGHEIGHT As Single = 67.5
Private Const PROGID_IMAGE = "Forms.Image.1"
Private yTop As Single

Private Sub UserForm_Initialize()
    With Me.ComboBox1
        yTop = .Top + .Height 'assign a starter point to make sure images don't hide combobox1
        .DropButtonStyle = fmDropButtonStyleReduce
        .ListStyle = fmListStylePlain
        .Style = fmStyleDropDownList
    End With
    Me.Caption = "Images in: " & imgPath() 'set the form caption
    loadSubfoldersList 'load subfolders list to combobox1
End Sub

Property Let context(ByVal formContext As String)
    pContext = formContext
    If Me.ComboBox1.Value <> pContext Then
        Me.ComboBox1.Value = pContext
        Exit Property
    End If
    Me.Label2.Caption = ""
    clearImagePlaceholders
    LoadImages
End Property

Private Sub ComboBox1_Change()
    context = Me.ComboBox1.Value
End Sub

Private Sub CommandButton1_Click() 'Press Esc to close the form
    Unload Me
End Sub

Private Sub createImagePalceholders(numberOfImages As Long)
    Dim i As Long, img As Control ' MSForms.Image
    Dim nrow As Long, ncol As Long
    Dim x As Single, y As Single
    With Me
        nrow = 0
        ncol = 0
        For i = 1 To numberOfImages
            Set img = .Controls.Add(PROGID_IMAGE, IMGNAMEPREFIX & i, True)
            x = ncol * (IMGWIDTH + IMGSPACE) + IMGSPACE
            If x + IMGWIDTH >= Me.InsideWidth Then
                nrow = nrow + 1
                ncol = 0
                x = IMGSPACE
            End If
            y = nrow * (IMGHEIGHT + IMGSPACE) + IMGSPACE
            With img
                .AutoSize = False
                .Width = IMGWIDTH
                .Height = IMGHEIGHT
                .Left = x
                .Top = y + yTop
                .PictureAlignment = fmPictureAlignmentCenter
                .PictureSizeMode = fmPictureSizeModeZoom
                .PictureTiling = False
                .BorderStyle = fmBorderStyleNone ' fmBorderStyleSingle
            End With
            ncol = ncol + 1
        Next i
    End With
End Sub

Private Function countFiles(fPath As String) As Long
    If Not FolderExists(fPath) Then
        countFiles = -1
        Exit Function
    End If
    Dim fso As Object 'late binding 'New FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    countFiles = fso.getfolder(fPath).Files.Count
    Set fso = Nothing
End Function

Private Sub LoadImages()
    Dim i As Long, n As Long
    Dim iName As String
    Dim iPath As String
    iPath = imgPath(pContext)
    n = countFiles(iPath)
    If n < 0 Then
        MsgBox "Folder does not exist!" & vbLf & iPath, vbCritical
        Exit Sub
    ElseIf n = 0 Then
        MsgBox "The folder contains no files!" & vbLf & iPath, vbInformation
        Exit Sub
    Else
        createImagePalceholders n
    End If
    
    Dim fso As Object 'late binding 'New FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim iFolder As Object, iFile As Object
    Set iFolder = fso.getfolder(iPath)
    With iFolder
        Me.Label2.Caption = .Files.Count & " files (" & Round(.Size / 1024 / 1024, 3) & " MB)"
    End With
    
    On Error Resume Next
    For Each iFile In iFolder.Files
        i = i + 1
        iName = iFile.Name
        With Me.Controls(IMGNAMEPREFIX & i)
            .Picture = LoadPicture(iFile.Path)
            .ControlTipText = iName
        End With
    Next iFile
    Repaint
End Sub

Private Sub loadSubfoldersList()
    Dim iFolder As String
    iFolder = imgPath()
    If Not FolderExists(iFolder) Then
        MsgBox "Folder does not exist!" & vbLf & iFolder, vbCritical
        GoTo EX
    End If

    Dim fso As Object 'late binding 'New FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim objFolder As Object
    Set objFolder = fso.getfolder(iFolder)
    Dim n As Long
    n = objFolder.subfolders.Count
    If n = 0 Then
        MsgBox "The folder contains no files!" & vbLf & iFolder, vbInformation
        GoTo EX
    End If
    Dim foldersList() As String
    ReDim foldersList(0 To n - 1)
    Dim subFolder As Object
    Dim i As Long
    For Each subFolder In objFolder.subfolders
        foldersList(i) = subFolder.Name
        i = i + 1
    Next subFolder

    With Me.ComboBox1
        .List = foldersList
        .ListIndex = 0
    End With

EX:
    On Error Resume Next
    Set fso = Nothing
    Set objFolder = Nothing
    Set subFolder = Nothing
    Erase foldersList
End Sub

Private Sub clearImagePlaceholders()
    Dim ctl As Control
    For Each ctl In Me.Controls
        If LCase(TypeName(ctl)) = "image" Then
            Me.Controls.Remove ctl.Name
        End If
    Next ctl
    Set ctl = Nothing
End Sub

The code in a code module:

Option Explicit

Const uf_Name As String = "UserForm1"
Public uf As Object
Const pimgSubPath = "images" 'Name of a folder containing subfolders with images; _
    The folder should be next to the workbook or to be a fully qualified path to an existing folder

Sub buildForm()
    Set uf = VBA.UserForms.Add(uf_Name)
    uf.context = "Try 3"
    uf.Show vbModeless
    'Stop
End Sub

Public Function TrailingSlash(varIn As Variant) As String
    'The TrailingSlash() function just ensures that _
    the folder names we are processing end with the slash character.
    
    If Len(varIn) > 0& Then
        If Right$(varIn, 1&) = Application.PathSeparator _
                Then TrailingSlash = varIn _
                Else TrailingSlash = varIn & Application.PathSeparator
    End If
End Function

Function FolderExists(ByVal strFolderName As String, Optional ForceMakeDir As Boolean = False) As Boolean
    Dim fso As Object 'late binding 'New FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    FolderExists = fso.FolderExists(strFolderName)
        
    'This part of the function is working well on Windows systems, it will probably fail on unix/MAC systems
    On Error Resume Next
    If ForceMakeDir And (Not FolderExists) Then
        fso.CreateFolder (strFolderName)
        FolderExists = fso.FolderExists(strFolderName)
        
        If Not FolderExists Then
            Dim i As Long, x As String, y
            If strFolderName Like "?:\*" Then
                x = Left(strFolderName, 3)
                y = Split(Mid(strFolderName, 4), Application.PathSeparator)
            ElseIf strFolderName Like "\\*" Then
                x = Left(strFolderName, 2)
                y = Split(Mid(strFolderName, 3), Application.PathSeparator)
            Else
                x = ""
                y = Null
            End If
        
            If (x <> "") And IsArray(y) Then
                For i = LBound(y) To UBound(y)
                    x = TrailingSlash(x) & y(i)
                    If Not FolderExists(x, True) Then Exit For
                Next i
            End If
            FolderExists = fso.FolderExists(strFolderName) 'Dir(strFolderName, vbDirectory) <> ""
        End If
        
        y = Null
    End If
    Set fso = Nothing
    
End Function

Function imgPath(Optional context As String) As String
    Dim p As String
    p = TrailingSlash(ThisWorkbook.Path)
    If Len(pimgSubPath) > 0& Then
        If FolderExists(pimgSubPath) Then
            p = TrailingSlash(pimgSubPath) 'if pimgSubPath is something like C:\SomeFolder\Folderwithimages
        Else
            p = TrailingSlash(p & pimgSubPath) 'if pimgSubPath is something just the name of a folder next to this workbook
        End If
    End If
    If Len(context) > 0& Then _
        p = TrailingSlash(p & context)
    imgPath = p
End Function

 

[nepakumar]

thanks a lot. the way you conceptualized the model is amazing.

 

[bobsan42]

Glad you like it. Surely some improvements can be made, but I put together in a hurry.
I normally use a completely blank form and build everything during runtime.