MS-Excel VBA | Get the Filename and Display the Image in a Shapes

[SoniboiTM]

Dear Sir,

My VBA code:

'Note: Error occurs when I use "Option Explicit"
Public pubPath As String
Public pubSetNum As String

Private Sub Worksheet_Activate()
    If Range("W6").Value = "" Then
        lstABCDImageList01.Clear
    End If
End Sub

Private Sub btnRamdomCharEng_Click()
    'ActiveX CommandButton
    If Not (Range("W6").Value = "") Then
        lstABCDImageList01.Clear
        lstABCDImageList01.AddItem "Set 1"  'individual character compose of 8 sets
        lstABCDImageList01.AddItem "Set 2"  'and each set has four images to display
        lstABCDImageList01.AddItem "Set 3"
        lstABCDImageList01.AddItem "Set 4"
        lstABCDImageList01.AddItem "Set 5"
        lstABCDImageList01.AddItem "Set 6"
        lstABCDImageList01.AddItem "Set 7"
        lstABCDImageList01.AddItem "Set 8"
    End If
  
    Call wRandomLetter

     Range("W6").Value = wRandomLetter
    Range("AH6").Value = "GENERATED CHARACTER(s):  " & UCase(Range("W6").Value) & LCase(Range("W6").Value)
    btnRamdomCharEng.Caption = "GENERATE CHARACTER"

    'Assigning "No Image Available" to all four rectangular shapes, initially.
    With ActiveSheet.Shapes("shpABCDPic01").Fill
        .Visible = msoTrue
            .UserPicture "C:\Users\Polgas\Desktop\JKL Files\Study Guide\Image\No Image Available.png"
        .TextureTile = msoFalse
    End With
    With ActiveSheet.Shapes("shpABCDPic02").Fill
        .Visible = msoTrue
            .UserPicture "C:\Users\Polgas\Desktop\JKL Files\Study Guide\Image\No Image Available.png"
        .TextureTile = msoFalse
    End With
    With ActiveSheet.Shapes("shpABCDPic03").Fill
        .Visible = msoTrue
            .UserPicture "C:\Users\Polgas\Desktop\JKL Files\Study Guide\Image\No Image Available.png"
        .TextureTile = msoFalse
    End With
    With ActiveSheet.Shapes("shpABCDPic04").Fill
        .Visible = msoTrue
            .UserPicture "C:\Users\Polgas\Desktop\JKL Files\Study Guide\Image\No Image Available.png"
        .TextureTile = msoFalse
    End With
End Sub

Private Sub lstABCDImageList01_Click()
    Select Case lstABCDImageList01  'ActiveX ListBox1
    Case "Set 1"
        pubSetNum = 1
    Case "Set 2"
        pubSetNum = 2
    Case "Set 3"
        pubSetNum = 3
    Case "Set 4"
        pubSetNum = 4
    Case "Set 5"
        pubSetNum = 5
    Case "Set 6"
        pubSetNum = 6
    Case "Set 7"
        pubSetNum = 7
    Case "Set 8"
        pubSetNum = 8
    End Select
    Call DisplayImageSet
End Sub

Public Function wRandomLetter(Optional rndType = 1) As String
    Randomize
    wRandomLetter = ""
  
    Select Case rndType
    Case 1
        randVariable = Int((122 - 65 + 1) * Rnd + 65)
        Do While randVariable > 90 And randVariable < 97
            randVariable = Int((122 - 65 + 1) * Rnd + 65)
        Loop
        wRandomLetter = Chr(randVariable)
    Case 2
        wRandomLetter = Chr(Int((122 - 97 + 1) * Rnd + 97))
    Case 3
        wRandomLetter = Chr(Int((90 - 65 + 1) * Rnd + 65))
    End Select
End Function

Function DisplayImageSet()
    Dim FolderName As String
    Dim FileName As String
    Dim ItemName As String
    Dim vChar As String
    Dim vCtr

    vChar = Range("W6").Value
    FolderName = "C:\Users\Polgas\Desktop\JKL Files\Study Guide\Image\ABC\"
    FileName = Dir(FolderName & vChar & "-S0" & pubSetNum & "*.png")

    'Debug.Print ""
    'Debug.Print "Item Name", "File Name", , "pubPath & File Name"
    'Debug.Print "------------", "---------------", "------------------------------------------------------------------------"

    Do While FileName <> ""
        vCtr = vCtr + 1
        FileName = Dir()
        If vCtr < 5 And InStr(FileName, ".") Then
            FileName = Dir(FolderName & vChar & "-S0" & pubSetNum & "*.png")
            ItemName = Mid(Left(FileName, InStr(FileName, ".") - 1), 7, Len(FileName))
            pubPath = FolderName & FileName
            'Debug.Print ItemName, FileName, , pubPath
            With ActiveSheet.Shapes("shpABCDPic0" & vCtr).Fill
                .Visible = msoTrue
                .UserPicture pubPath
                .TextureTile = msoFalse
            End With
        End If
    Loop
End Function

My problem is in this part, the code is able to display only one image in four rectangular shapes (please see attached .jpg file for clarification):

    Do While FileName <> ""
        vCtr = vCtr + 1
        FileName = Dir()

    If vCtr < 5 And InStr(FileName, ".") Then
        FileName = Dir(FolderName & vChar & "-S0" & pubSetNum & "*.png")
            ItemName = Mid(Left(FileName, InStr(FileName, ".") - 1), 7, Len(FileName))
            pubPath = FolderName & FileName
            With ActiveSheet.Shapes("shpABCDPic0" & vCtr).Fill
                .Visible = msoTrue
                .UserPicture pubPath
                .TextureTile = msoFalse
            End With
        End If
    Loop

Regards,

 

[DanteAmor]

My problem is in this part, the code is able to display only one image

It seems to me, in this case, the correct is to call a Sub instead of Function
Try this:

Sub DisplayImageSet()
  Dim FolderName As String, FileName As String, vChar As String
  Dim vCtr As Long
  
  vChar = Range("W6").Value
  FolderName = "C:\Users\Polgas\Desktop\JKL Files\Study Guide\Image\ABC\"
  FileName = Dir(FolderName & vChar & "-S0" & pubSetNum & "*.png")
  
  Do While FileName <> "" And vCtr < 5
    vCtr = vCtr + 1
    With ActiveSheet.Shapes("shpABCDPic0" & vCtr).Fill
      .Visible = msoTrue
      .UserPicture FolderName & FileName
      .TextureTile = msoFalse
    End With
    FileName = Dir()
  Loop
End Sub

 

[SoniboiTM]

It seems to me, in this case, the correct is to call a Sub instead of Function
Try this:

Sub DisplayImageSet()
  Dim FolderName As String, FileName As String, vChar As String
  Dim vCtr As Long

  vChar = Range("W6").Value
  FolderName = "C:\Users\Polgas\Desktop\JKL Files\Study Guide\Image\ABC\"
  FileName = Dir(FolderName & vChar & "-S0" & pubSetNum & "*.png")

  Do While FileName <> "" And vCtr < 5
    vCtr = vCtr + 1
    With ActiveSheet.Shapes("shpABCDPic0" & vCtr).Fill
      .Visible = msoTrue
      .UserPicture FolderName & FileName
      .TextureTile = msoFalse
    End With
    FileName = Dir()
  Loop
End Sub

Thank you, Sir, for your help. It's working.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.