Discussion :

[sojobo38420]

Bonjour,

Actuellement en première année de BTS IRIS, je suis en stage et je dois effectuer un macro qui exécute une automatisation de copie de composants.

Alors je vous explique mon problème, j'ai effectuer une macro qui ouvre un fichier excel, et qui parcours ligne par ligne le fichier. Avant d'ouvrir le fichier on demande a l'utilisateur un mot clé, ce mot clé que rentre l'utilisateur c'est ce que va chercher ma macro dans ce fichier.
Par exemple si le mot clé rentré dans l'inputbox est 20140525_3, la boucle qui suit va chercher dans mon classeur excel source toute les lignes qui contiennent ce mot clé, et maintenant ce que j'aimerais faire c'est que quand le mot clé est trouvé dans la le fichier excel c'est de créer automatiquement une arborescence dans un dossier source.
Cela donnerait en gros : "macro" : mot clé trouver alors => arborescence a créer : A[i](répertoire) J[i](sous-répertoire) et I[i](fichier).

Voila je vous transmet mon code et en pièce jointe le fichier source sur lequel ma macro est effectuée.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
' Date : 24/06/2014
' Auteur : BOUCHET Thibaut
'
'=========   IMPORTANT    ===================="
'Nécessite d'activer la référence "Microsoft Scripting RunTime"
        'Dans l'éditeur de macros (Alt+F11):
        'Menu Outils
        'Références
        'Cochez la ligne "Microsoft Scripting RunTime".
        'Cliquez sur le bouton OK pour valider.
'============================================="
'Descriptif:
'Boite à outils visant à optimiser la tâche de déploiement de release par les membres du Centre de service
'Réalisation de macro qui permet :
'Une automatisation de la création des packages de releases ETL à destination d’IBM pour une mise en production suivant les préconisations d’Euromaster
'============================================="
Sub Initialisation()
Set fso = New FileSystemObject
Dim objShell, objFolderCible, objFolderReleases As Object
Dim CheminCible, CheminReleases, Path_parent, nom_release As String
Dim Longueur_chaine_totale, intPosition  As Integer
Dim x As Long
Dim Colonne As Byte
Dim Wbk As Workbook
 
'Sélection du fichier Excel listant les composants à livrer pour la release concernée
'Ouverture de la fenêtre de choix des répertoire contenant des fichier avec l'extension .xls ou .xlsx
ChDrive "C" ' Choix d'un lecteur donné
MsgBox "Veuillez séléctionner un fichier Excel"
FichierOuvert = Application.GetOpenFilename("Fichiers Excel (*.xlsx),*.xlsx, Excel (*.xls),*.xls ")
If FichierOuvert = "Faux" Then
    MsgBox "Vous n'avez sélectionné aucun fichier", vbCritical, "Annulation"
    Exit Sub
End If
 
'Sélection du répertoire source
'Ouverture de la fenêtre de choix du répertoire source
With Application.FileDialog(msoFileDialogFolderPicker)
    'Définit un titre pour la boîte de dialogue
    .Title = "Choix du dossier de release ETL à analyser:"
    'Affiche la boîte de dialogue
    .Show
    'Affiche le nom du dossier sélectionné
    If .SelectedItems.Count > 0 Then
        'Utilisation_FileDialog_SelectionDossier = .SelectedItems(1)
        Longueur_chaine_path = Len(.InitialFileName)
        Longueur_chaine_totale = Len(.SelectedItems(1))
        Path_complet = .SelectedItems(1)
        'Path_parent = .InitialFileName
        'nom_release = Right(.SelectedItems(1), (Longueur_chaine_totale - Longueur_chaine_path))
        ' On cherche la position du caractère \ en partant de la fin
        ' workaround pb observé sur pc AST
        intPosition = InStrRev(Path_complet, "\")
        If intPosition <> 0 Then
            Path_parent = Mid(Path_complet, 1, intPosition - 1)
            If MsgBox("Le dossier cible est il correct ? : " & Path_complet, vbYesNo) = vbNo Then
                Exit Sub
            End If
        End If
    Else
        MsgBox "Vous n'avez pas sélectionné de répertoire source", vbCritical, "Annulation"
        Exit Sub
End If
End With
 
'Sélection du répertoire cible
'Ouverture de la fenêtre de choix du répertoire cible
Set objShell = CreateObject("Shell.Application")
Set objFolderCible = objShell.BrowseForFolder(&H0&, "Choisir un répertoire cible", &H1&)
'Gestion d'erreur
If objFolderCible Is Nothing Then
    MsgBox "Vous n'avez pas sélectionné de répertoire cible", vbCritical, "Annulation"
    Exit Sub
End If
'sinon
'CheminCible = répertoire choisi
CheminCible = objFolderCible.ParentFolder.ParseName(objFolderCible.Title).Path & "\"
'Vérification du choix du dossier Cible
If MsgBox("Le dossier cible est il correct ? :" & CheminCible, vbYesNo) = vbNo Then
     Exit Sub
End If
 
motClef = InputBox("Veuillez entrer le mot clef : ", "Access")
If motClef = "" Then
    MsgBox "Le mot clef ne peut pas être vide , veuillez réessayer", vbExclamation
End If
 
Set Wbk = Workbooks.Open(FichierOuvert)
Wbk.Sheets(1).Activate
'Parcourir fichier excel ligne par ligne
Dim DernièreLigne As Long
Dim i As Long
 
    DernièreLigne = ActiveSheet.Range("A65536").End(xlUp).Row + 1 '1ere cellule non rempli après la dernier rempli dans la colonne A
 
    For i = 1 To DernièreLigne 'parcoure de la ligne 1 à la derniere ligne remplie
        If Cells(i, 18).Value = motClef Then 'condition --> si ta ligne n'est pas vide
            MsgBox "Trouvé"
        End If
    Next i
 
End Sub

Merci d'avance =)