Discussion :

[GeomR]

Bonjour,

Je m'y connais pas beaucoup en VB et je suis en train de créer une fonction qui me permet de récupérer certaines données d'un tableau Excel pour les transférer vers un tableau récapitulatif.

Voilà la fonction que j'ai faite. Elle récupère certaines données de la fiche X, pour les transférer dans mon tableau final en remplissant horizontalement à partir de la colonne 7. A chaque fiche, on change de ligne :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub CommandButton1_Click()
 
Dim derlig As Integer, i As Integer, mavar As String
 
derlig = Workbooks("CoordonnéesBIPI.xls").Sheets("Antony").Range("g65536").End(xlUp).Row + 1
 
For i = 11 To 22
mavar = Workbooks("Fiche_PI_BI_920190001.xls").Sheets("Page 1").Cells(i, 3).Value
Workbooks("CoordonnéesBIPI.xls").Sheets("Antony").Cells(derlig, i - 4).Value = mavar
 
Next
 
End Sub

Mon problème c'est que j'ai près de 300 fiches à transférer dans ce même tableau. J'aimerai donc une fonction qui me permet d'ouvrir ma première fiche, de transférer les données sur le tableau de sortie puis de fermer la fiche.
En recliquant sur mon bouton, la fonction ouvre la fiche suivante (les numéros de fiche se suivent), transfère les données et ferme, etc...

J'espère que j'ai été assez clair.

Merci d'avance

[Le Pierre]

bonjour

Est-ce que le nom de tes tableaux à récupérer ont un format normalisé ?
Par exemple de la forme : Données0001.xls; Données0002.xls; ...

Est-ce ces tableaux sont tous dans le même répertoire ?

Si c'est oui dans les deux cas, il existe une solution simple.

à plus

[GeomR]

Bonjour,

Alors mes tableaux sont de la forme suivante : Fiche_PI_BI_920190001.xls; Fiche_PI_BI_920190002.xls; etc...

J'ai deux dossiers différents, avec a peu près 150 tableaux dans chaque. Seul les 5 premiers chiffres diffèrent, ils correspondent a un code postal :

Fiche_PI_BI_916450001.xls
Fiche_PI_BI_920190001.xls

Voila !

[Le Pierre]

bonjour

voici un bout de code à inclure dans un module.
lance la procédure "test" qui te demanderas de choisir un fichier Excel dans le répertoire de ton choix. Tu peux choisir n'importe quel fichier mais seuls ceux débutants par "Fiche_PI_BI_" seront ouverts et fermés sans sauvegarde l'un après l'autre
tu devras inclure ta procédure de copie de données après "place ici ton code de traitement"
il faudra lancer la procédure pour chaque répertoire

à plus

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
Sub test()
    Application.ScreenUpdating = False
 
    Fichier_Analyse = ThisWorkbook.Name
    Call RechercheFichier(Chemin, Fichier)
    Windows(Fichier_Analyse).Activate
 
 
    Fichier_à_Analyser = Dir(Chemin & "\Fiche_PI_BI_*.xls")
    If Fichier_à_Analyser <> "" Then
        Do
            Application.StatusBar = "Traitement du fichier " & Fichier_à_Analyser
 
            Workbooks.Open Filename:= _
                Chemin & "\" & Fichier_à_Analyser, local:=True
            Windows(Fichier_à_Analyser).Activate
 
            '-----------------
            '---place ici ton code de traitement
            '-----------------
 
 
            '-----------------
            Windows(Fichier_à_Analyser).Activate
            ActiveWindow.Close SaveChanges:=False
 
            Fichier_à_Analyser = Dir
            If Fichier_à_Analyser = "" Then Exit Do
        Loop
    End If
    Application.StatusBar = ""
    Beep
    Application.ScreenUpdating = True
 
End Sub
 
Sub RechercheFichier(Chemin, Fichier)
    If Chemin <> "" Then
        '--- Se place dans le répertoire de l'application ---
        Path = Chemin
        Lect = Left(Path, 1)
        ChDrive Lect
        If InStr(1, Path, "\", 1) <> 0 Then
            ChDir Path
        End If
    End If
 
    fileToOpen = Application _
        .GetOpenFilename("(*.xls),*.xls")
 
    x = 0
    Do
        x = InStr(x + 1, fileToOpen, "\")
        If x = 0 Then Exit Do
        Memox = x
    Loop Until x = 0
    Chemin = Left(fileToOpen, Memox)
    Fichier = Right(fileToOpen, Len(fileToOpen) - Memox)
 
    '--- Se place dans le répertoire de l'application ---
    Path = Chemin
    Lect = Left(Path, 1)
    ChDrive Lect
    If InStr(1, Path, "\", 1) <> 0 Then
        ChDir Path
    End If
End Sub

[GeomR]

Merci pour ton morceau de code. Je l'ai testé, mais j'ai un message d'erreur qui se produit "Erreur de compilation, élément nommé introuvable".

Alors j'ai essayé par bout de code, la première partie marche, mais à partir de la partie en rouge il y a une erreur.

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
Sub test()

    Dim derlig As Integer, i As Integer, mavar As String

    Application.ScreenUpdating = False

    Fichier_Analyse = ThisWorkbook.Name
    Call RechercheFichier(Chemin, Fichier)
    Windows(Fichier_Analyse).Activate


    Fichier_à_Analyser = Dir(Chemin & "\Fiche_PI_BI_*.xls")
    If Fichier_à_Analyser <> "" Then
        Do
            Application.StatusBar = "Traitement du fichier " & Fichier_à_Analyser

            Workbooks.Open Filename:= _
                Chemin & "\" & Fichier_à_Analyser, local:=True
            Windows(Fichier_à_Analyser).Activate


        derlig = Workbooks("CoordonnéesBIPI.xls").Sheets("Antony").Range("g65536").End(xlUp).Row + 1

    For i = 11 To 22
            mavar = Workbooks("Fiche_PI_BI_920190001.xls").Sheets("Page 1").Cells(i, 3).Value
            Workbooks("CoordonnéesBIPI.xls").Sheets("Antony").Cells(derlig, i - 4).Value = mavar

    Next

            Windows(Fichier_à_Analyser).Activate
            ActiveWindow.Close SaveChanges:=False

            Fichier_à_Analyser = Dir
            If Fichier_à_Analyser = "" Then Exit Do
        Loop
    End If
    Application.StatusBar = ""
    Beep
    Application.ScreenUpdating = True
'
End Sub
 
Sub RechercheFichier(Chemin, Fichier)
    If Chemin <> "" Then
        '--- Se place dans le répertoire de l'application ---
        Path = Chemin
        Lect = Left(Path, 1)
        ChDrive Lect
        If InStr(1, Path, "\", 1) <> 0 Then
            ChDir Path
        End If
    End If
    
    fileToOpen = Application _
        .GetOpenFilename("(*.xls),*.xls")
    
    x = 0
    Do
        x = InStr(x + 1, fileToOpen, "\")
        If x = 0 Then Exit Do
        Memox = x
    Loop Until x = 0
    Chemin = Left(fileToOpen, Memox)
    Fichier = Right(fileToOpen, Len(fileToOpen) - Memox)
    
    '--- Se place dans le répertoire de l'application ---
    Path = Chemin
    Lect = Left(Path, 1)
    ChDrive Lect
    If InStr(1, Path, "\", 1) <> 0 Then
        ChDir Path
    End If
End Sub

Et ça ne t'ennuie pas, est ce que tu pourrais me détailler un peu ce que fait le code ? Que je m'y retrouve un peu

Merci d'avance !

[Le Pierre]

bonjour

c'est curieux je n'ai pas d'erreur avec mon fichier de test :
http://cjoint.com/?ekruIgRtCG
essaye le et dis moi si tu as toujours l'erreur ?
à plus

[GeomR]

J'ai exactement la même erreur avec ton fichier de test

[Le Pierre]

J'ai Excel 2002 et toi ?

[GeomR]

J'ai Excel 2000 ! Visiblement y a un problème de version.

[Le Pierre]

bonjour

essaye de modifier le nom de la variable "Fichier_à_Analyser " par "FichierAnalyser " par exemple.
Il se pourrait que le "à" pose problème

à plus

[GeomR]

Visiblement ça va mieux, mais il y avait un soucis aussi avec le "local:= True" qui ne passait pas non plus.

Maintenant j'ai un message d'erreur de ce style "Erreur définie par l'application ou par l'objet" et il ne m'indique pas l'endroit ou il pourrait y avoir une erreur.

[Le Pierre]

exécute le code en mode pas à pas. Tu devrais trouver le morceau qui pose problème.
à plus