Discussion :

[Philippe Tulliez]

Bonjour,

POURQUOI IL FAIT PLUS RIEN ET AFFICHE LE MSGBOX DIRECTEMENT

Il est inutile de hurler ainsi.

J'ai détaillé pas à pas et je ne vois pas ce qui cloche

Ligne 20, je suppose que la variable fichier est vide. Si c'est le cas, je l'ai expliqué au-dessus et j'ai donné un lien pour comprendre le mécannisme de DIR

[rossemma]

sorry touche restée enfoncée ==> erreur de ma part

j'ai trouvé mon erreur, oublié une barre dans le chemin
il trouve le fichier
mais ne veux pas l'ouvrir et dit qu'il est est introuvable
pourtant le fichier existe
je vais poursuivre mes recherches...

[rossemma]

voici le code modifié et fonctionnel :

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
Sub Export_Janvier()
 
    Sheets("MOIS-MAAND").Range("J2:L" & ActiveSheet.UsedRange.Rows.Count - 1).ClearContents
    Dim Chemin As String, Fichier As String
    Dim Wb As Workbook
     'Définit le répertoire contenant les fichiers
    Chemin = "\\spvfilebru020.intra.just.fgov.be\Services\ACA\Budget\Dir-Budget\Cel-Bud\#Tabl_MonitoringPersonnel-Tab_MonitoringPersoneel\#DATA_2017\extract_SAP\"
    'Boucle sur tous les fichiers xls du répertoire.
    Fichier = Dir(Chemin & "Janvier*.xlsx")
    Do While Fichier <> ""
        Set Wb = Workbooks.Open(Chemin & Fichier)
        Range("A2:C" & ActiveSheet.UsedRange.Rows.Count - 1).Copy
        ThisWorkbook.Sheets("MOIS-MAAND").Range("J1048576").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation _
            :=xlNone, SkipBlanks:=False, Transpose:=False
        Call ClearClipboard
        Wb.Close True
        Set Wb = Nothing
        Fichier = Dir
    Loop
    Sheets("MOIS-MAAND").Range("J1").Activate
 
End Sub

Merci à tous pour votre aide

Je me demandais si il y avait moyen de copier sans avoir à ouvrir les classeurs sources???

[rossemma]

Hyper content de moi
Grace à vos renseignements le code est fonctionnel et j'ai même ajouté un test préalable

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
Sub Export_Test()
 
    Dim Chemin As String, Fichier As String
    Dim Wb As Workbook
    'Définit le répertoire contenant les fichiers
    Chemin = "\\spvfilebru020.intra.just.fgov.be\Services\ACA\Budget\Dir-Budget\Cel-Bud\#Tabl_MonitoringPersonnel-Tab_MonitoringPersoneel\#DATA_2017\extract_SAP\"
    'Boucle sur tous les fichiers xls du répertoire.
    Fichier = Dir(Chemin & "Janvier*.xlsx")
    If Fichier <> "" Then
        Sheets("MOIS-MAAND").Range("J2:L" & ActiveSheet.UsedRange.Rows.Count - 1).ClearContents
        Do While Fichier <> ""
            'Désactive l'évènement
            Application.EnableEvents = False
            ' ouvre fichier trouvé
            Set Wb = Workbooks.Open(Chemin & Fichier)
            ' copy/paste les données
            Range("A2:C" & ActiveSheet.UsedRange.Rows.Count).Copy
            ThisWorkbook.Sheets("MOIS-MAAND").Range("J1048576").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation _
                :=xlNone, SkipBlanks:=False, Transpose:=False
            Call ClearClipboard
            ' ferme le fichier trouvé en cours
            Wb.Close True
            Set Wb = Nothing
            Fichier = Dir
        Loop
        MsgBox "Données exportées"
        Sheets("MOIS-MAAND").Range("J1").Activate
        'Réactive l'évènement
        Application.EnableEvents = True
    Else
    MsgBox "fichiers n'existent pas"
    End If
End Sub

Il me reste juste, vu ce code va être ajouté à mes boutons "Mois", à avoir comment faire pour mettre la variable "chemin" pour tous les boutons sans avoir à le mettre dans le code à chaque fois.

[Menhir]

Il me reste juste, vu ce code va être ajouté à mes boutons "Mois", à avoir comment faire pour mettre la variable "chemin" pour tous les boutons sans avoir à le mettre dans le code à chaque fois.

Fait une déclaration ce constante en zone publique (avant les modules).
https://msdn.microsoft.com/fr-fr/lib.../gg264655.aspx

Quoi que... une simple déclaration Public suffirait sans doute.
https://msdn.microsoft.com/fr-fr/lib.../gg264680.aspx

[Philippe Tulliez]

Bonjour,

Il me reste juste, vu ce code va être ajouté à mes boutons "Mois", à avoir comment faire pour mettre la variable "chemin" pour tous les boutons sans avoir à le mettre dans le code à chaque fois.

Utiliser une feuille paramètre dans laquelle on prévoit une cellule qui contiendra le chemin. C'est le plus simple à mettre en place et permet une facilité pour la maintenance et surtout rend pérenne l'application.
Cependant je l'ai déjà écrit plus haut, il est préférable d'utiliser la propriété Path en organisant la gestion des fichiers et répertoires en fonction d'un répertoire principal.

[rossemma]

Merci mais j'ai solutionné mon problème avec "PATH"

voici le code :

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
Sub Export_Janvier()
 
    Application.ScreenUpdating = False
    Dim Chemin As String, Fichier As String
    Dim Wb As Workbook
    'Définit le répertoire contenant les fichiers
    Chemin = ThisWorkbook.Path
    Folder = "\extract_SAP\"
    'Boucle sur tous les fichiers xls du répertoire
    Fichier = Dir(Chemin & Folder & "Janvier*.xlsx")
       If Fichier <> "" Then
        Sheets("MOIS-MAAND").Range("B2:D" & ActiveSheet.UsedRange.Rows.Count - 1).ClearContents
        Do While Fichier <> ""
            'Désactive l'évènement
            Application.EnableEvents = False
            ' ouvre fichier trouvé
            Set Wb = Workbooks.Open(Chemin & Fichier)
            ' copy/paste les données
            Range("A2:C" & ActiveSheet.UsedRange.Rows.Count).Copy
            ThisWorkbook.Sheets("MOIS-MAAND").Range("B1048576").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation _
                :=xlNone, SkipBlanks:=False, Transpose:=False
            Call ClearClipboard
            ' ferme le fichier trouvé en cours
            Wb.Close True
            Set Wb = Nothing
            Fichier = Dir
        Loop
        MsgBox "Données exportées"
        Sheets("MOIS-MAAND").Range("B1").Activate
        'Réactive l'évènement
        Application.EnableEvents = True
    Else
    MsgBox "Les fichiers n'existent pas"
    End If
    Application.ScreenUpdating = True
End Sub

Cependant, je souhaiterais un peu l'optimiser.

Je vais avoir 12 boutons (un par mois, nommé comme tel) et je voudrais utiliser le même code.
Voici à mon sens ce qui doit changer d'un bouton à l'autre :
- Fichier = Dir(Chemin & Folder & "Janvier*.xlsx") : le mois doit correspondre au nom du bouton
- ThisWorkbook.Sheets("MOIS-MAAND").Range("B1048576").... : B1048576 qui deviendrait J1048576 pour février, etc => peut être le stipulé sous forme de liste mois par mois
- Sheets("MOIS-MAAND").Range("B1").Activate : idem qu'au dessus.

J'espère que je m'explique correctement étant novice en VBA.

Merci pour votre aide

[Philippe Tulliez]

Bonjour,

Je vais avoir 12 boutons (un par mois, nommé comme tel) et je voudrais utiliser le même code.

pas besoin de 12 boutons. Un seul suffit.
Toujours dans une feuille paramètre, prévoir une table à deux colonnes avec en colonne

1. Le mois
2. Le numéro de la colonne (B pour janvier, J pour février, etc.)

Prévoir une liste déroulante et avec RECHERCHEV on aura le mois, et la colonne (B, J, etc.)
Le chemin est le même ? prévoir une cellule pour le chemin. Le nom du fichier étant l'équivalent du nom du mois, une fois le mois sélectionné on connaît le nom du fichier à chercher et la colonne à sélectionner et un seul bouton pour activer la procédure.
ce n'est plus de la programmation, c'est de l'organisation (jamais faire deux fois la même chose) paramétrer ce qui peut l'être.

[rossemma]

Voila j'ai créé une feuille "setup" avec un tableau en deux colonnes

Mois Colonne
Janvier B
Février J
... ...

Mais je n'arrive pas à intégrer celui-ci à mon code.

J'ai recherché et trouvé Vlookup mais vois pas comment l'intégrer.

Merci pour vos lumières...

[Philippe Tulliez]

Bonjour,
En cellule A2 de la feuille [Tableau], une liste déroulante faisant référence à la plage A2:A4 de la feuille nommée [Parameter] en cellule B2 de la feuille nommée [Tableau] la fonction

Code :

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

=RECHERCHEV(A2;Parameter!$A$2:$B$4;2;FAUX)

Ainsi dès que l'on aura sélectionné un élément dans la liste nous aurons la lettre de la colonne.
Ce qui signifie que les valeurs dans les cellules A2 & B2 de la feuille [Tableau] constituent les deux paramètres de la procédure de copie.



Je n'ai pas voulu rendre plus difficile mon explication mais il est évident que nommer les cellules et plages de cellules concernées est un plus indéniable.

[pijaku]

Bonjour,

ou alors avec une Sub paramétrée :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub Export(mois As String)
 
    Application.ScreenUpdating = False
    Dim Chemin As String, Fichier As String
    Dim Wb As Workbook
    'Définit le répertoire contenant les fichiers
    Chemin = ThisWorkbook.Path
    Folder = "\extract_SAP\"
    'Boucle sur tous les fichiers xls du répertoire
    Fichier = Dir(Chemin & Folder & mois & "*.xlsx")
'etc...

Qu'on appelle comme ceci :

Code :

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

1
2
3
Private Sub CommandButton1_Click()
    Call Export("Janvier")
End Sub

EDIT :
ou encore, une initiation intéressante, avec un tout petit minuscule module de classe :
Dans un module standard :

Code :

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

Public MesBoutons(11) As New Classe1

Dans un module de classe nommé Classe1 :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Public WithEvents CBTN As MSForms.CommandButton
 
Private Sub CBTN_Click()
    'mettre ici le contenu de la sub Export
    'il faut adapter, par exemple régler la propriété Caption des boutons de commande
    'afin de compléter, grâce à elle, le chemin d'accès aux fichiers
    'et adapter cette ligne :
    'Fichier = Dir(Chemin & Folder & "Janvier*.xlsx")
    'comme ceci :
    'Fichier = Dir(Chemin & Folder & CBTN.Caption & "*.xlsx")
    MsgBox CBTN.Caption
End Sub

et dans le module de l'userform
j'ai supposé que :
- les propriétés Name des commandbutton avaient été définies comme ceci : BTN_MOIS_1, BTN_MOIS_2, ... ou le chiffre représente le numéro du mois
- les propriétés Caption des CommandButton sont définies en fonction des mois (attention à la casse) afin d'accéder aux bons fichiers (Janvier, Février, etc... Attention aux majuscules, accents, espaces...)

Code :

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

1
2
3
4
5
6
Private Sub UserForm_Initialize()
Dim b As Byte
    For b = 1 To 12
        Set MesBoutons(b - 1).CBTN = Me.Controls("BTN_MOIS_" & b)
    Next b
End Sub

[Philippe Tulliez]

Bonjour Franck,

ou alors avec une Sub paramétrée :

C'est exactement le sens de mes dernières réponses et les paramètres se trouvent dans les cellules A2 et B2.

[rossemma]

Un grand merci à tous
cela fonctionne nickel

[rossemma]

Voici mon code définitif
Hyper content de moi vu mes faibles connaissances en VBA

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
Private Sub CBTN_Click()
 
    Dim Chemin As String, Fichier As String, col1 As String, col2 As String
    Dim Wb As Workbook
    Dim rep As Variant, Folder As Variant
    Dim NBFichier As Integer
 
        'Définit le répertoire contenant les fichiers
        Chemin = ThisWorkbook.Path & Application.PathSeparator
        Folder = "extract_SAP\"
 
        'Tous les fichiers xlsx du répertoire
        Fichier = Dir(Chemin & Folder & CBTN.Caption & "*.xlsx")
 
    While Not Fichier = ""
        NBFichier = NBFichier + 1
        Fichier = Dir
    Wend
 
        rep = MsgBox("Voulez-vous continuer et importer" & " " & NBFichier & " " & "fichiers" & " " & "pour" & " " & CBTN.Caption & " ? ", vbYesNo + vbQuestion + vbApplicationModal + _
            vbDefaultButton2, "")
 
        col1 = Application.WorksheetFunction.VLookup(CBTN.Caption, Sheets("setup").Range("A3:C14"), 2, 0)
        col2 = Application.WorksheetFunction.VLookup(CBTN.Caption, Sheets("setup").Range("A3:C14"), 3, 0)
 
        Fichier = Dir(Chemin & Folder & CBTN.Caption & "*.xlsx")
 
    Application.ScreenUpdating = False
    If rep = vbYes Then
        If Fichier <> "" Then
        Sheets("MOIS-MAAND").Range(col1 & "2" & ":" & col2 & ActiveSheet.UsedRange.Rows.Count - 1).ClearContents
            Do While Fichier <> ""
                'Désactive l'évènement
                Application.EnableEvents = False
                ' ouvre fichier trouvé
                Set Wb = Workbooks.Open(Chemin & Folder & Fichier)
                ' copy/paste les données en valeurs
                Range("A2:C" & ActiveSheet.UsedRange.Rows.Count).Copy
                ThisWorkbook.Sheets("MOIS-MAAND").Range("B1048576").End(xlUp).Offset(1, 0).PasteSpecial _
                    Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Call ClearClipboard
                ' ferme le fichier trouvé en cours
                Wb.Close True
                Set Wb = Nothing
                Fichier = Dir
            Loop
        MsgBox "Les données sont importées", vbOKOnly + vbInformation, ""
        Sheets("MOIS-MAAND").Range(col1 & "1").Activate
        'Réactive l'évènement
        Application.EnableEvents = True
        'Sauve les données importées
        ThisWorkbook.Save
        Else
        MsgBox "Un ou plusieurs fichiers n'existent pas"
        End If
    Else
    End If
    Application.ScreenUpdating = True
    ThisWorkbook.Save
 
End Sub

Encore merci pour votre aide à tous.