Microsoft 365 VBA - Lister les photos sélectées dans l'Explorateur Windows

Sub DetermineTheSelectedFiles() 
  'It needs `Microsoft Internet Controls`. Take care of adding this reference!
  Dim ExpWin As SHDocVw.ShellWindows, CurrWin As SHDocVw.InternetExplorer
  Set ExpWin = New SHDocVw.ShellWindows
  
   For Each CurrWin In ExpWin
        If Not CurrWin.Document Is Nothing Then
            If Not CurrWin.Document.FocusedItem Is Nothing Then
                Debug.Print CurrWin.Document.FocusedItem.Path: Stop
            End If
        End If
    Next CurrWin
End Sub

Sub SelectionnerRepertoireImage()
' Sélection du répertoire
' Copie du nom de TOUS les fichiers images du répertoire dans le tableau
Dim Repertoire
Dim i As Integer
Dim n As Integer
Dim Ligne As Integer
Dim FichierImage As Object
Dim NomCourtImage As String

    Application.ScreenUpdating = False
    With Application.FileDialog(msoFileDialogOpen)
    ' Indiquer le chemin complet du Repertoire par défaut
        .InitialFileName = "C:\Users\" & Environ("username") & "\Documents\"
        .AllowMultiSelect = True
        .InitialView = msoFileDialogViewLargeIcons
        .Filters.Add "Images", "*.gif; *.jpg; *.jpeg", 1
        .Show
        If .SelectedItems.Count > 0 Then
            Repertoire = .InitialFileName
            Range("NOM_REP_IMG") = Repertoire
            ActiveSheet.Range(TAB_IMAGES).ClearContents
            i = 0
            ActiveSheet.Range(TAB_IMAGES).Resize(ActiveSheet.Range(TAB_IMAGES).Rows.Count, ActiveSheet.Range(TAB_IMAGES).Columns.Count).Name = TAB_IMAGES
            For i = 1 To .SelectedItems.Count
                NomCourtImage = Mid(CStr(.SelectedItems(i)), InStrRev(CStr(.SelectedItems(i)), "\") + 1)
                ActiveSheet.Range(TAB_IMAGES).Cells(i, 1) = NomCourtImage
            Next i
            ActiveSheet.Range(TAB_IMAGES).Resize(i, ActiveSheet.Range(TAB_IMAGES).Columns.Count).Name = TAB_IMAGES
            
            ' Tri du tableau par nom image croissant
            ActiveSheet.Sort.SortFields.Clear
            ActiveSheet.Sort.SortFields.Add _
                Key:=Range(TAB_IMAGES).Columns(1), _
                SortOn:=xlSortOnValues, _
                Order:=xlAscending, _
                DataOption:=xlSortNormal
            With ActiveSheet.Sort
                .SetRange Range(TAB_IMAGES)
                .Header = xlGuess
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            MsgBox .SelectedItems.Count & " images dans le répertoire sélectionné" & vbCrLf & "Le tableau est trié sur le nom", vbInformation
        Else
            RepertoireAvecImages = False
        End If
    End With
    Application.ScreenUpdating = True
End Sub