Navigation dans Windows et ouverture de fichier

Le 26/07/2022 à 15:41

Bonjour la communauté,

Je démarque en VBA et après des recherches sur le forum, une question persiste. (Je suis un peu frustré car je sais le faire en Python, mais ne peux l'utiliser dans ma situation).

Voici le sujet :

Je souhaite récupérer des informations de différents Excel, présents dans des dossiers, et dont les noms sont standardisés. C'est une sorte d'arbre à 3 branches (niveau A) composés de 3 dossiers, eux mêmes composés de x dossiers (niveau B) et à l'intérieur desquels, se trouvent des excels dont je veux copier/coller les mêmes cellules.

J'ai donc un arbre du type (voir photo)

Je souhaiterais donc réaliser un code qui me permettent d'itérer à l'intérieur du 3ème niveau de l'arbre pour récupérer les cellules dont j'ai besoin. Mon problème c'est que les noms de mes fichiers sont du type : A1_A13_''nom différent à chaque fois''.xlsx

Or, j'ai créer des menus coulissants permettants à l'utilisateur de sélectionner A1 et A13, puis de les concatener, mais je ne sais pas comment procéder intelligement avec le ''nom différent à chaque fois''

Avez-vous une idée ?

Merci par avance

PS : Dans MonFichier j'ai tapé le nom du fichier à la main... rien d'automatique, ce qui est un peu le nerf de la guerre

Sub OuvertureDeFichier()

On Error GoTo OuvertureFichierErreur
    'Définition des variables
    Dim Ax As String
    Dim Axx As String

    Ax = Feuil1.ComboBox1.Value
    Axx = Feuil1.ComboBox2.Value
    'MsgBox (Ax) & (Axx)

    Dim MonApplication As Object
    Dim MonFichier As String
    Set MonApplication = CreateObject("Shell.Application")

    MonFichier = "C:MonDossier" & Ax & "\" & Axx & "\Ax_Axx_Nom.xlsx"

    MonApplication.Open (MonFichier)

    Set MonApplication = Nothing

Exit Sub

OuvertureFichierErreur:
    Set MonApplication = Nothing
    MsgBox "Erreur lors de l'ouverture de fichier..."
Exit Sub
Le 26/07/2022 à 15:46

Bonjour,

Sauf erreur de ma part il n'y a ni fichier ni photo ?

Avez vous pensez à passer par power query ?

Le 26/07/2022 à 15:51

Bonjour Valentin85,

En effet, je n'arrive à upload ma photo :/ Après elle n'apporte par grand chose, c'est juste une représentation de la structure des dossiers (arbre de proba classique à 3 niveaux, donc les 2 premiers ont une nomenclatures standardisés mais pas le 3ième.)

Et pour ce qui est de Power Query, ne connaissant pas je vais regarder ce qu'il en est. (Je débute de chez débute)

En tout cas merci de votre réponse :)

Le 26/07/2022 à 15:59

Si vous voulez un peu plus de détail, il me faudrait un fichier exemple (sans données confidentielles mais avec une structure identique) Afin de vous montrer ce qu'il est possible de faire.

Mais pour faire simple Power query permet d'importer des fichiers et de les transformer(comprenez par la = récupérer les informations voulus) avant de les importer. Il est possible de lui dire d'aller chercher dans un dossier spécifique (qui serait ici le premier dossier de votre arborescence)

Le 26/07/2022 à 16:29

Je peux vous partager le fichier sur lequel je travail maintenant, ce sera peut être plus clair.

Il vous manque le fichier source : CPR_Luxury_Breitling.xlsx

Dites moi si c'est plus clair :) Merci

11test.xlsm (30.94 Ko)
Le 27/07/2022 à 08:47

Bonjour,

Donc ce que vous avez envoyé c'est le résultat que vous voulez obtenir ?

il faut aussi que je sache à quoi ressemble les fichiers sur les quels vous voulez extraire les données. les fichiers "sources".

Il me faut seulement la structure , vous pouvez mettre des données bidons dedans.

Et enfin pouvez vous me fournir l'arborescence ? mettez l'image dans un fichier Excel sinon

Le 27/07/2022 à 10:20

Bonjour Valentin85,

C'est que ce n'était pas clair alors :)

Je vous ai rajouté dans TEST la photo de l'arbre des différents dossiers, et aussi le modèle source avec CPR_Luxury_Breitling

Ainsi, dans TEST, le but est de copier des données venant CPR_Luxury_Breitling et ce, dans la feuille DATA.

Et de le faire pour toutes les entreprises présentes dans le dossier CPR --> Luxury.

Le but final est que l'utilisateur choisisse ''Industry'' puis ''SubIndustry'' et le code VBA complète le tableau présent dans DATA avec toutes les entreprises présentent dans le dossier.

J'imagine devoir faire une boucle pour parcourir toutes les entreprises, mais je ne sais pas en VBA sur quelle variable povoir itérer pour y arriver.

Merci d'avance pour votre aide

8cpr-luxury-breitling-copy.xlsx (46.42 Ko)
10test.xlsm (134.23 Ko)
Le 27/07/2022 à 11:57

Bonjour,

Je ne dois plus être très loin de la vérité j'ai pas mal avancé. mais j'ai l'impression que vous gérer plusieurs feuilles.. car il y a pas mal de Colonnes que vous voulez que je ne retrouves pas dans votre base.

Je vous montre ce que j'ai fais mais c'est un début. Voir l'arbre que j'ai fais pour vous montrer le principe que j'ai pris.

Mais j'ai quand même l'impression que je me suis embarqué dans un truc un peu tiré par les cheveux

17test-10.xlsm (156.44 Ko)
Le 28/07/2022 à 17:31

Bonjour Valentin,

Déjà un grand merci pour votre aide, et l'énergie que vous avez mis pour résoudre ce sujet.
Je m'en suis débrouillé autrement, et ca fonctionne bien !

Je vous mets le code ici :)

Encore merci à vous,

Bien cordialement,

Sub Macro1()

Dim BDD As FileDialog 'déclare la variable BDD (Boîte de Dialogue Dossier)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim FS As String 'décalre la variable FS (Fichier Source)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS1 As Worksheet
Dim OS2 As Worksheet
Dim OS5 As Worksheet
Dim OS8 As Worksheet 'déclare la variable OS (Onglet Source)
Dim DEST As Range 'déclare la variable DEST (celllue de DESTination)
'Dim a As Integer

Application.ScreenUpdating = False

'définit la boîte de dialogue BDD (permetant de définit le dossier des fichiers source)
Set BDD = Application.FileDialog(msoFileDialogFolderPicker)
With BDD 'prend en compte BDD
    .AllowMultiSelect = False 'n'autorise qu'une seule sélection
    .Show 'affiche BDD
    If .SelectedItems.Count = 0 Then Exit Sub 'si bouton [Annuler], sort de la procédure
    CA = .SelectedItems(1) & "\" 'définit la chemin d'accès CA aux fichiers à ouvrir
End With 'fin de la prise en compte de BDD

Set CD = ThisWorkbook 'définit la classeur destination CD
Set OD = CD.Sheets("DATA") 'définit l'onglet destination OD (à adapter à ton cas, ici j'ai mis le premier onglet)
'Set OD.Cells(Application.Rows.Count, "A").CurrentRegion.Clear

FS = Dir(CA & "*.xlsx") 'définit le premier fichier source Excel contenu dans le dossier ayant CA comme chemin d'accès
Set DEST = OD.Range("A2")
Do While FS <> "" ' exécute tant qu'il existe des fichiers source
    Workbooks.Open CA & FS 'ouvre le fichier source FS
    Set CS = ActiveWorkbook 'définit la classeur source CS
    Set OS1 = CS.Worksheets("1. General information") 'définit l'onglet source OS
    Set OS2 = CS.Worksheets("2. Scope 3 emissions")
    Set OS5 = CS.Worksheets("5. Carbon reduction targets")
    Set OS8 = CS.Worksheets("8. Energy consumption & targets")

    DEST.Value = OS1.Range("F3").Value
    DEST.Offset(0, 1).Value = OS1.Range("F7").Value
    DEST.Offset(0, 2).Value = OS1.Range("F8").Value
    DEST.Offset(0, 3).Value = OS1.Range("F9").Value
    DEST.Offset(0, 4).Value = OS1.Range("F14").Value
    DEST.Offset(0, 5).Value = OS1.Range("F19").Value
    DEST.Offset(0, 6).Value = OS1.Range("F22").Value
    DEST.Offset(0, 7).Value = OS1.Range("F24").Value
    DEST.Offset(0, 8).Value = OS1.Range("F25").Value
    DEST.Offset(0, 9).Value = OS2.Range("B2").Value
    DEST.Offset(0, 10).Value = OS2.Range("B3").Value
    DEST.Offset(0, 11).Value = OS2.Range("B4").Value
    DEST.Offset(0, 12).Value = OS2.Range("B5").Value
    DEST.Offset(0, 13).Value = OS2.Range("B6").Value
    DEST.Offset(0, 14).Value = OS2.Range("B7").Value
    DEST.Offset(0, 15).Value = OS2.Range("B8").Value
    DEST.Offset(0, 16).Value = OS2.Range("B9").Value
    DEST.Offset(0, 17).Value = OS2.Range("B10").Value
    DEST.Offset(0, 18).Value = OS2.Range("B11").Value
    DEST.Offset(0, 19).Value = OS2.Range("B12").Value
    DEST.Offset(0, 20).Value = OS2.Range("B13").Value
    DEST.Offset(0, 21).Value = OS2.Range("B14").Value
    DEST.Offset(0, 22).Value = OS2.Range("B15").Value
    DEST.Offset(0, 23).Value = OS2.Range("B16").Value
    DEST.Offset(0, 24).Value = OS2.Range("B17").Value
    DEST.Offset(0, 25).Value = OS2.Range("B18").Value
    DEST.Offset(0, 26).Value = OS1.Range("F33").Value
    DEST.Offset(0, 27).Value = OS1.Range("F41").Value
    DEST.Offset(0, 28).Value = OS1.Range("F42").Value
    DEST.Offset(0, 29).Value = OS1.Range("F37").Value
    DEST.Offset(0, 30).Value = OS1.Range("F40").Value
    DEST.Offset(0, 31).Value = OS1.Range("F58").Value
    DEST.Offset(0, 32).Value = OS1.Range("F83").Value
    'DEST.Offset(0, 33).Value = OS5.Range("B8").Value
    'DEST.Offset(0, 34).Value = OS5.Range("B8").Value
    'DEST.Offset(0, 35).Value = OS5.Range("B8").Value
    DEST.Offset(0, 36).Value = OS1.Range("F64").Value
    DEST.Offset(0, 37).Value = OS1.Range("F65").Value
    DEST.Offset(0, 38).Value = OS1.Range("F76").Value
    DEST.Offset(0, 39).Value = OS1.Range("F74").Value
    DEST.Offset(0, 40).Value = OS1.Range("F75").Value
    DEST.Offset(0, 41).Value = OS8.Range("B8").Value
    DEST.Offset(0, 42).Value = OS8.Range("D8").Value
    DEST.Offset(0, 43).Value = OS8.Range("B3").Value
    DEST.Offset(0, 44).Value = OS8.Range("B4").Value
    DEST.Offset(0, 45).Value = OS8.Range("B5").Value
    DEST.Offset(0, 46).Value = OS8.Range("B6").Value
    DEST.Offset(0, 47).Value = OS8.Range("D3").Value
    DEST.Offset(0, 48).Value = OS8.Range("D4").Value
    DEST.Offset(0, 49).Value = OS8.Range("D5").Value
    DEST.Offset(0, 50).Value = OS8.Range("D6").Value
    DEST.Offset(0, 51).Value = OS8.Range("G29").Value
    DEST.Offset(0, 52).Value = OS8.Range("I38").Value

    Set DEST = DEST.Offset(1, 0)

    CS.Close False 'ferme le claseur source CS (sans enregistrer)
    FS = Dir 'définit le prochain fichier source excel du dossier ayant CA comme chemin d'accès
Loop 'boucle

MsgBox "The sheet is ready"

End Sub
Rechercher des sujets similaires à "navigation windows ouverture fichier"