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

SoniboiTM

New Member
Joined
Jul 25, 2020
Messages
38
Office Version
  1. 2019
Platform
  1. Windows
  2. Web
Dear Sir,

My VBA code:

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):

Code:
    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,

Set1.jpg
 
Last edited:

Some videos you may like

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
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:

VBA Code:
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
 
Last edited:
Solution

SoniboiTM

New Member
Joined
Jul 25, 2020
Messages
38
Office Version
  1. 2019
Platform
  1. Windows
  2. Web
It seems to me, in this case, the correct is to call a Sub instead of Function
Try this:

VBA Code:
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.
 

Attachments

  • DispayImage.jpg
    DispayImage.jpg
    158.4 KB · Views: 2

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
I'm glad to help you. Thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,118,309
Messages
5,571,468
Members
412,395
Latest member
nielsvanlit
Top