Récupérer une partie du nom d'un fichier ouvert à partir du classeur maitre

Le 06/10/2023 à 19:51

Bonjour à tous et toutes.

Petite question... J'alimente 2 tableaux en cherchant et ouvrant 2 fichiers Excel depuis mon classeur principal. Comme c'est une action que je fait tous les jours sauf le week-end, je ne peut pas utiliser la formule =aujourdhui pour avoir simplement ma date tous les jours.

Les 2 fichiers que j'ouvre contiennent dans leurs noms la date du jour à laquelle ils me sont envoyés. En gros xxxxxxxx061023.xlsx

Ce que j'aimerais, c'est que quand j'arrive le lundi et que j'ouvre le fichier du samedi depuis mon classeur, la partie contenant la date du 1er fichier que j'ouvre se copie dans une cellule afin que je puisse l'utiliser comme référence.

Merci d'avance à ceux qui pourrons m'aider.

Cordialement,

François

Le 06/10/2023 à 20:37

Bonjour,

Voici un exemple de code qui pourrait te convenir.

Sub Extraire6CaracteresAvantExtension()

    Dim nomFichier As String
    Dim nomFichierSansExtension As String
    Dim caracteres As String
    Dim CheminFichier As String

    With Application.FileDialog(msoFileDialogFilePicker)

        If .Show = -1 Then ' Si l'utilisateur clique sur Ouvrir
            CheminFichier = .SelectedItems(1)
        Else
            Exit Sub ' L'utilisateur a annulé la sélection
        End If
    End With

    ' Extraire le nom du fichier sans le chemin d'accès
    nomFichier = Right(CheminFichier, Len(CheminFichier) - InStrRev(CheminFichier, Application.PathSeparator))

    ' Supprimez l'extension du nom de fichier
    nomFichierSansExtension = Left(nomFichier, InStrRev(nomFichier, ".") - 1)

    ' Extrait les 6 caractères précédant l'extension
    If Len(nomFichierSansExtension) >= 6 Then
        caracteres = Right(nomFichierSansExtension, 6)
    End If

    ' Affichez les 6 caractères dans la cellule A1
    Range("A1") = caracteres
End Sub
Le 06/10/2023 à 20:51

Bonsoir Oiseau Bleu,

Pourrais tu me dire comment je peut combiner ta solution avec ce code???

En tous cas, merci beaucoup !!!!!!!

Private Sub BTN1_Click()

    Dim CheminFichier As String
    Dim FeuilleSource As Worksheet
    Dim TableauDestination As ListObject
    Dim DerniereLigneSource As Long

    ' Désactive la mise à jour de l'écran pour améliorer les performances
    Application.ScreenUpdating = False

    ' Ouvre la boîte de dialogue pour sélectionner le fichier source
    CheminFichier = Application.GetOpenFilename("Fichiers Excel (*.xls; *.xlsx), *.xls; *.xlsx")

    ' Vérifie si un fichier a été sélectionné
    If CheminFichier = "Faux" Then
        MsgBox "Aucun fichier sélectionné. L'opération a été annulée.", vbExclamation
        Exit Sub
    End If

    ' Définit la feuille de calcul source
    Set FeuilleSource = Workbooks.Open(CheminFichier).Worksheets(1) ' Vous pouvez ajuster le numéro de la feuille si nécessaire

    ' Définit le tableau de destination
    On Error Resume Next
    Set TableauDestination = ThisWorkbook.Sheets("Calcul").ListObjects("TBL_HSTS") ' Assurez-vous que la feuille et le tableau sont correctement nommés
    On Error GoTo 0

    ' Vérifie si le tableau de destination existe
    If Not TableauDestination Is Nothing Then
        ' Trouve la dernière ligne de la colonne A dans la feuille source
        DerniereLigneSource = FeuilleSource.Cells(FeuilleSource.Rows.Count, "A").End(xlUp).Row

        ' Copie les données de la colonne A, B, C et D de la feuille source vers le tableau de destination
        If DerniereLigneSource >= 2 Then ' Vérifie s'il y a au moins 1 ligne de données (à partir de la ligne 2 de la source)
            TableauDestination.ListRows.Add
            FeuilleSource.Range("A2:C" & DerniereLigneSource).Copy TableauDestination.ListColumns(1).DataBodyRange
            MsgBox "Données copiées avec succès!", vbInformation
        Else
            MsgBox "La feuille source ne contient pas de données à copier.", vbExclamation
        End If
    Else
        MsgBox "Le tableau de destination n'a pas été trouvé dans la feuille 'Calcul'.", vbExclamation
    End If

    ' Ferme le fichier source sans enregistrer les modifications
    Workbooks.Open(CheminFichier).Close SaveChanges:=False
End Sub
Le 07/10/2023 à 16:11

Bonjour,

Voici le code ajusté pour toi.

Private Sub BTN1_Click()

    Dim CheminFichier As String
    Dim FeuilleSource As Worksheet
    Dim TableauDestination As ListObject
    Dim DerniereLigneSource As Long
    Dim nomFichier As String
    Dim nomFichierSansExtension As String
    Dim caracteres As String

    ' Désactive la mise à jour de l'écran pour améliorer les performances
    Application.ScreenUpdating = False

    ' Ouvre la boîte de dialogue pour sélectionner le fichier source
    CheminFichier = Application.GetOpenFilename("Fichiers Excel (*.xls; *.xlsx), *.xls; *.xlsx")

    ' Vérifie si un fichier a été sélectionné
    If CheminFichier = "Faux" Then
        MsgBox "Aucun fichier sélectionné. L'opération a été annulée.", vbExclamation
        Exit Sub
    End If

    ' Définit la feuille de calcul source
    Set FeuilleSource = Workbooks.Open(CheminFichier).Worksheets(1) ' Vous pouvez ajuster le numéro de la feuille si nécessaire

    ' Définit le tableau de destination
    On Error Resume Next
    Set TableauDestination = ThisWorkbook.Sheets("Calcul").ListObjects("TBL_HSTS") ' Assurez-vous que la feuille et le tableau sont correctement nommés
    On Error GoTo 0

    ' Vérifie si le tableau de destination existe
    If Not TableauDestination Is Nothing Then
        ' Trouve la dernière ligne de la colonne A dans la feuille source
        DerniereLigneSource = FeuilleSource.Cells(FeuilleSource.Rows.Count, "A").End(xlUp).Row

        ' Copie les données de la colonne A, B, C et D de la feuille source vers le tableau de destination
        If DerniereLigneSource >= 2 Then ' Vérifie s'il y a au moins 1 ligne de données (à partir de la ligne 2 de la source)
            TableauDestination.ListRows.Add
            FeuilleSource.Range("A2:C" & DerniereLigneSource).Copy TableauDestination.ListColumns(1).DataBodyRange

            ' Extraire le nom du fichier sans le chemin d'accès
            nomFichier = Right(CheminFichier, Len(CheminFichier) - InStrRev(CheminFichier, Application.PathSeparator))

            ' Supprimez l'extension du nom de fichier
            nomFichierSansExtension = Left(nomFichier, InStrRev(nomFichier, ".") - 1)

            ' Extrait les 6 caractères précédant l'extension
            If Len(nomFichierSansExtension) >= 6 Then
                caracteres = Right(nomFichierSansExtension, 6)

                ' Affichez les 6 caractères dans la cellule A1 où défini un autre cellule dans la feuille que tu veux ta date du fichier apparaisse
                FeuilleSource.Range("A1") = caracteres
            End If

            MsgBox "Données copiées avec succès!", vbInformation
        Else
            MsgBox "La feuille source ne contient pas de données à copier.", vbExclamation
        End If
    Else
        MsgBox "Le tableau de destination n'a pas été trouvé dans la feuille 'Calcul'.", vbExclamation
    End If

    ' Ferme le fichier source sans enregistrer les modifications
    Workbooks.Open(CheminFichier).Close SaveChanges:=False
End Sub
Le 08/10/2023 à 13:03

Merci beaucoup, c'est nickel !!!!!!

Bon dimanche

Rechercher des sujets similaires à "recuperer partie nom fichier ouvert partir classeur maitre"