Excelで画像表示ソフトを作ってみよう

'フォルダ内のファイル一覧を表示
Private Sub ExGetFileList(strPath As String)
    Dim i As Long
    Dim tSfo As Object
    Dim tGf As Object
    Dim tFi As Object
    Dim tSub As Object
    Dim last As Long
    Dim sext As String
    
    Range("B3:C65536") = ""
    
    '項目名の表示
    Range("B2") = "画像ファイル名"
    Range("B2").HorizontalAlignment = xlHAlignCenter
    Columns("B").ColumnWidth = 20
    
    Range("C2") = "作成日・時間"
    Range("C2").HorizontalAlignment = xlHAlignCenter
    Columns("C").ColumnWidth = 20
    
    Range("B2:C2").Borders(xlEdgeBottom).Weight = xlThick
    Range("B2:C2").Borders(xlEdgeBottom).LineStyle = xlContinuous
    
    '画像ファイルを探す
    Set tSfo = CreateObject("Scripting.FileSystemObject")
    Set tGf = tSfo.GetFolder(strPath)
    i = 3
    For Each tFi In tGf.Files
        sext = LCase(Right(tFi.Name, 3))
        ' JPEG か BMP か判定
        If sext = "jpg" Or sext = "bmp" Then
            'ファイル名
            Cells(i, 2) = tFi.Name
            '作成日
            Cells(i, 3) = tFi.DateCreated
            i = i + 1
            If i >= 65536 Then
                Exit For
            End If
        End If
    Next
     
    '日時でソート
    If i > 3 Then
        last = Range("B65536").End(xlUp).Row
        Range("B4:C" & last).Sort Key1:=Range("C1") _
        , Order1:=xlAscending _
        , Header:=xlNo _
        , MatchCase:=False _
        , Orientation:=xlTopToBottom _
        , SortMethod:=xlPinYin
    End If
    
    Range("B2").Select
    Range("B3").Select
End Sub

下記のVBAコードに変更してください。

'「参照」ボタン
Private Sub CommandButton1_Click()
    Dim s1 As String
    Dim sdir As String
    
    If TextBox1.Text = "" Then
        sdir = sMyBookPath
    Else
        sdir = TextBox1.Text
    End If
    'フォルダ選択ダイアログ
    s1 = SelectFolder_FileDialog(sdir)
    If s1 <> "" Then
        TextBox1.Text = s1
        ExGetFileList s1
    End If
End Sub

Private Sub UserForm_Initialize()
    Dim sdir As String
    Dim buf As String * 256
    
    Range("B3:C65536") = ""
    
    'このファイルがあるフォルダを取得
    sMyBookPath = ActiveWorkbook.Path
    If Right$(sMyBookPath, 1) <> "\" Then sMyBookPath = sMyBookPath + "\"

    '読込先フォルダの初期値
    GetPrivateProfileString "画像初期値", "フォルダ", "", buf, Len(buf), sMyBookPath & "gazo.ini"
    sdir = Left$(buf, InStr(buf, vbNullChar) - 1)
    'フォルダの存在確認
    If ExDir(sdir, vbDirectory) = "" Then
        sdir = ""
    Else
        ExGetFileList sdir
    End If
    TextBox1.Text = sdir
End Sub