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

[danielco]

Bonjour,

Je cherche une procédure me permettant de lister et de recopier les phots sélectionnées dans l'Explorateur de fichiers.

Merci d'avance.

Daniel

 

[crocrocro]

Bonjour le fil, bonjour @danielco
@danielco, vous avez dû déjà trouvé sur XLD ou ailleurs, un certain nombre de procédures qui répondent à peu-près à votre besoin.
Si vous voulez avoir des réponses réellement adaptées, soyez plus précis dans votre demande, par xemeple :
- tous types de fichiers images (jpeg, png ...)
- dans le répertoire sélectionnés seulement ou également dans les sous-répertoires
- quelles informations de chaque fichier à lister dans le tableau (nom complet, nom court, taille, date création ...)
- vider le tableau à chaque sélection
- ...

Par exemple en pj

 

[danielco]

Bonjour,
Dans l'explorateur, je sélectionne certaines photos ou videos, quelle que soit l'extension du fichier, dans l'Explorateur de fichiers. Donc, les photos sélectionnés se trouvent dans le même dossier. Mon but est de copier ces fichiers dans un autre dossier. Je n'ai rien trouvé qui réponde à mon besoin sauf peut-être ce code de Stack Overflow mais qui ne trouve que le dernier fichier sélectionné :

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

Un fois le nom des fichiers récupérés, je n'ai pas de problème pour les traiter. Je veux par exemple copier ces trois fichiers :

Daniel

 

[crocrocro]

Bonsoir Daniel,
je viens de m'apercevoir que j'étais à côté de la plaque :
je pensais que vous vouliez simplement copier les image récupérées depuis l'explorateur dans la feuille

je vous ferai une proposition plus complète

 

[TooFatBoy]

Bonjour,

Je cherche une procédure me permettant de lister et de recopier les phots sélectionnées dans l'Explorateur de fichiers.

Juste une question en passant : est-ce qu'il ne serait pas plus simple de sélectionner les fichiers depuis la Boîte de dialogue fichier plutôt que de passer par l'Explorateur de fichiers ?
Au moins, ça éviterait de sortir d'Excel.

 

[crocrocro]

En pj nouvelle version.
Ne prendre en compte que la feuille 2.
Mode opératoire :
1- Bouton Sélectionner le répertoire des images
Les fichiers images (extension définies dans la macro EstImage) sont listées dans le tableau.
Actuellement les infos affichées dans le tableau sont Nom court, Taille, dimensions et date de création (facilement adaptables)
2- Ne conserver dans le Tableau Structuré que les lignes correspondant au fichiers à copier
3- Bouton Sélectionner le répertoire de copie
4- Bouton Copie des images dans le répertoire
Les fichiers images du tableau sont copiées dans le répertoire de copie (remplacent la copie précédente si elle existe).

 

[crocrocro]

Je m'aperçois que j'avais oublié de joindre le fichier
Le voici.
J'ajoute une remarque :
Beaucoup de code sans doute inutile. J'ai continué sur l'idée fausse de départ qui était simplement d'afficher les fichiers images dans un tableau et l'ai complété pour la copie. Je suppose que seul le nom du fichier est nécessaire pour l'affichage dans le tableau.

 

[crocrocro]

Une version améliorée plus light avec des contrôles complémentaires au moment de la copie :
- Existence des répertoires (au cas où cellules modifiées manuellement)
- Existence des fichiers à copier (au cas où cellules modifiées manuellement)
- Existence des fichiers dans le répertoire de copie (si existe déjà, pas de remplacement, voir code à adapter pour option remplacement)

Pour ne pas copier certaines images du tableau, les remettre à blanc.

 

[danielco]

Bonjour,


Juste une question en passant : est-ce qu'il ne serait pas plus simple de sélectionner les fichiers depuis la Boîte de dialogue fichier plutôt que de passer par l'Explorateur de fichiers ?
Au moins, ça éviterait de sortir d'Excel.

Bonjour à tous,
Non, parce que le sélectionne les photos après les avoir visualisées.
Daniel

 

[danielco]

Re, @crocrocro
Je n'ai pas eu le temps jusqu à maintenant, désolé. Je regarde ta solution.
Daniel

 

[danielco]

@crocrocro :
Je suis mal, parce que l'image que j'ai postée t'a envoyé dans une mauvaise direction. Je vais tâcher d'être plus clair. Je sélectionne les photos dans l'explorateur de fichiers. Les photos sont affichées sous forme de "grandes icônes", par exemple :

Je souhaite que la macro les copie directement dans le dossier voulu. Mon problème est de récupérer le nom des photos choisies. Après, la copie ne me pose pas de problème.

Daniel

 

[Valtrase]

Bonjour à tous,

Non, parce que le sélectionne les photos après les avoir visualisées.

Je ne vois pas où est le problème avec Application.FileDialog(msoDialogFilePicker)
Vous pouvez voir les photos.
Exemple :

 

[TooFatBoy]

est-ce qu'il ne serait pas plus simple de sélectionner les fichiers depuis la Boîte de dialogue fichier plutôt que de passer par l'Explorateur de fichiers ?
Au moins, ça éviterait de sortir d'Excel.

Non, parce que le sélectionne les photos après les avoir visualisées.

La Boîte de dialogue fichier permet aussi de visualiser les images, si je ne me trompe.

---

Peut-être qu'une simple sélection des fichiers dans l'Explorateur de fichiers ne suffit pas et qu'il faudrait aussi faire un "Copier" pour les mettre dans le presse-papiers.

Mais franchement, passer par la Boîte de dialogue fichier me paraît plus simple, aussi bien à programmer qu'à utiliser.

Et du coup ça m'amène à te poser une autre question : puisque tu passes par l'Explorateur de fichiers, pourquoi aller passer par Excel pour copier/coller (ou déplacer) les fichiers, plutôt que de le faire naturellement dans l'Explorateur de fichiers ???

 

[crocrocro]

Bonjour le fil,
@danielco , à quoi çà sert que Ducros, il se décarcasse ?
ici, simplement la macro à remplacer (je ne refournis pas pour le moment le fichier complet)

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

 

[Valtrase]

Re,
Petit classeur exemple avec possibilité soit de déplacer, soit de copier les fichiers d'un répertoire à un autre