Importer le nom d'un fichier dans une colonne Résolu

Question

Bonjour, 

J'utilise ce code pour importer des infos sur des fichiers présents dans un répertoire choisi.

Je voudrais réduire la sélection à un seul fichier, et ne récupérer que son nom dans la cellule sélectionnées Cells(2, f_Name), puis l'étendre sa valeur à toute la colonne.

Je vous avoue que cela me dépasse, j'ai fait des essais en remplaçant quelques instructions, mais sans succès...

'**********************************************************************************
'   Boite de dialogue chemin d'accès au répertoire sources
'**********************************************************************************

Dim Repertoire As FileDialog

Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)

Repertoire.Show
    chemin = CStr(Repertoire.SelectedItems(1))

'**********************************************************************************
'   Récupère les propriétés défies des fichiers du répertoire
'**********************************************************************************

Dim f_Name As Integer, f_Size As Integer, f_DateCreated As Integer

f_Name = Rows(1).Find("Nom importation", , , , xlByRows, xlPrevious).Column
        f_Size = Rows(1).Find("Taille image (Octet)", , , , xlByRows, xlPrevious).Column
        f_DateCreated = Rows(1).Find("Date de prise de vue (jj/mm/aaaa)", , , , xlByRows, xlPrevious).Column
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set Dossier = fs.GetFolder(chemin)
    Ligne = 2

For Each F In Dossier.Files
        Cells(Ligne, f_Name) = F.NAME
        Cells(Ligne, f_Size) = F.Size
        Cells(Ligne, f_DateCreated) = F.DateCreated
        Ligne = Ligne + 1
    Next

Lo.

michel_m · Answer

Bonjour
un petit truc au passage
pour la date de création----> type long et non integer
par ex: aujourd'hui donne 42166
idem pour la taille en octet si Integer dépassement de capacité pour un classeur de maxi 32,767 Ko

Désolé pour le reste: pas compris ce que tu désirais; je te laisse donc dans les mains de notre ami Le Pingou que je salue
:o)

dhaze · Answer

Ça avance un peu...
J'ai déjà récupéré le nom du fichier :

Sub Nom_Fichier_TIF()

Dim Boîte_de_Dialogue As String
    Dim Chemin_Fichier 'As ?
    Dim Nom_Fichier_TIF 'As ?

Boîte_de_Dialogue = Application.GetOpenFilename(FileFilter:="Fichier TIF(*.tif),*.tif", _
        Title:="Sélectionner le fichier TIFF")

If Boîte_de_Dialogue = "False" Or Boîte_de_Dialogue = "Faux" Then Exit Sub ' !!! Bilingue :< Bug en anglais !!!
        
        Chemin_Fichier = Split(Boîte_de_Dialogue, "\")
        Nom_Fichier_TIF = Chemin_Fichier(UBound(Chemin_Fichier))

MsgBox Nom_Fichier_TIF

End Sub

JvDo · Answer

Bonjour,

il ne faut pas déclarer Boîte_de_Dialogue en chaîne de caractère. C'est un variant.
Du coup, tu n'as pas besoin de tester sa valeur selon la langue.

Si tu veux déclarer Chemin_Fichier as string, il faut ajouter des () car c'est un tableau : Chemin_Fichier() as string

Sinon, tu peux réduire le code :
Sub Nom_Fichier_TIF()Dim Boîte_de_Dialogue 'pas "As String". c'est un variantBoîte_de_Dialogue = Application.GetOpenFilename(FileFilter:="Fichier TIF(*.tif),*.tif", _Title:="Sélectionner le fichier TIFF")If Boîte_de_Dialogue = False Then    MsgBox "pas de fichier sélectionné"Else    MsgBox Split(Boîte_de_Dialogue, "\")(UBound(Split(Boîte_de_Dialogue, "\")))End IfEnd Sub

cordialement

dhaze · Answer

Merci JvDo pour ces conseils.

Voici la macro complète :

Sub Importation_Nom_Mire()

'**********************************************************************************
'   Sélectionne et récupère le nom du fichier TIFF
'**********************************************************************************

Dim Boîte_de_Dialogue As Variant
    Dim Chemin_Fichier As String
    
    Boîte_de_Dialogue = Application.GetOpenFilename(FileFilter:="Fichier TIFF(*.tif),*.tif", _
    Title:="Sélectionner le fichier TIFF")
    
    If Boîte_de_Dialogue = False Then
        Exit Sub
    Else
        Nom_Fichier_TIFF = Split(Boîte_de_Dialogue, "\")(UBound(Split(Boîte_de_Dialogue, "\")))
    End If

'**********************************************************************************
'   Copier le nom dans toute la colonne "Référence de calibration"
'**********************************************************************************

Dim Colonne_Mire, Numération, Dernière_Ligne As Long
    
        Colonne_Mire = Rows(1).Find("Référence de calibration", , , , xlByRows, xlPrevious).Column
        Dernière_Ligne = Columns(Colonne_Mire).Offset(, -1).Find("*", , , , xlByColumns, xlPrevious).Row
    
    For Numération = Dernière_Ligne To 2 Step -1
    Cells(Numération, Colonne_Mire).Select
        With ActiveCell
            ActiveCell.Value = Nom_Fichier_TIFF
        End With
    Next Numération

End Sub

Lo.

Importer le nom d'un fichier dans une colonne

4 réponses

Discussions similaires

Newsletters