Discussion :

[Lyndils]

Bonjour,

J'ai essayé de créer le programme que je vais vous montrer après. Celui-ci à une partie qui crash.

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
Sub RecupérationDesDonnées()
 
'Déclaration de variables
    Dim Fichier As String
    Dim Chemin As String
    Dim Nom_classeur As String
    Dim Repertoire As FileDialog
    Dim Wb As Workbook
    i = 0
    e = 0
 
' Choix du chemin
    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Repertoire.Show
    Chemin = Repertoire.SelectedItems(1)
 
'Choix du fichier
    Fichier = Dir(Chemin & "\" & "*.xls")
 
 
'Boucle d'actions
    Do While Fichier <> ""
        'Ouverture du fichier source et activation de la page
            Set Wb = Workbooks.Open(Chemin & "\" & Fichier)
            Worksheets(1).Activate
            Nom_classeur = ActiveWorkbook.Name
 
        ' Sélection et copie des valeurs souhaitées
            Range("A1:G1").Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy
 
        'Choix du document de synthèse
            Workbooks("Recup.xlsm").Activate
 
        'Copie des valeurs
            Sheets("Feuil1").Activate 'sélectionne la feuille du transfert
            Range("D65000").End(xlUp).Offset(1).Select 'recherche la première cellule vide
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
        'Report du nom du rapport (du fichier)
            ' Selectionne la première cellule du tableau de la feuille1
                Sheets("Feuil1").Activate 'sélectionne la feuille1 du transfert
 
            ' Boucle tant que pas vide
            Do While Not (IsEmpty(Range("D2")))
 
 
                Cells(1 + e, 1).Value = Left(Nom_classeur, InStr(Nom_classeur, ".xls") - 1)
                e = e + 1
 
            Loop
 
        ' Fermeture du fichier source
            Wb.Close True
 
        ' Réinitialisation des indicateurs
            Set Wb = Nothing
            i = i + 1
            Fichier = Dir
 
 
    Loop
 
 
 
 
End Sub

J'espère que vous trouverez l'erreur à l'intérieur, je ne comprends toujours pas pourquoi il crash.
Sachant que je vois le fonctionner puis après ne rien faire.

Merci d'avance à ce qui prendrons le temps de m'aider!

Lyndils.

[Quentin77170]

Salut à toi,

As-tu lu ton programme en pas à pas (F8) en affichant la fenêtre des variables locales pour contrôler pourquoi ton programme boucle dans le vide ?
Sinon glisse dans une des tes boucles un "DoEvents", ça te permettra de toujours avoir la main et d'arrêter le programme plus facilement sans crasher ton fichier.

Dis-nous en plus... quelle boucle tourne sans raison ? Ou alors c'est simplement que ça nécessite du temps...

Quentin

PS : j'aime bien le Do While Not Pourquoi pas Do Until ? Je taquine :p

[Lyndils]

Bonjour,

Oui, j'avais oublié qu'on pouvait utiliser F8...

Bin pour le Until je savais pas qu'elle existé! héhé

Ca plant dans la boucle avec le l'incrémentation des noms de fichiers, car quand je ne l'avais aps mis le programme fonctionné bien.

Je vais essayé avec F8.

Lyndils

[Lyndils]

Re,

Apparemment, j'ai réussi à accéder au débogage après avoir fait du pas à pas.

L'erreur viendrai apparemment au moment où il y a:

Code :

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

Cells(1 + e, 1).Value = Left(Nom_classeur, InStr(Nom_classeur, ".xls") - 1)

Y a t-il quelques chose que je j'ai mal écris?

Lyndils

[Marc-L]

Bonjour, bonjour !

En survolant le code, je ne sais si c'est en rapport mais il manque certainement
des neurones dans la ligne n°46 ou sinon dans les lignes suivantes (49 & 50) !
A traduire en langage parlé puis à comparer avec ce qu'elles devraient en fait réaliser …

Edit : code et message d'erreur ? S'il n'y en a pas, conception défaillante, à revoir …

_____________________________________________________________________________________________________
Je suis Charlie - Je suis Bardo

[Lyndils]

Je crois qu'il m'affiche un problème type "range" à la fin avant le mode débogage.

Je suis vraiment mauvais en VBA et là, je crois que je suis arrivé à ma limite.

[mercatog]

Une proposition

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
Sub RecuperationDesDonnees()
Dim Chemin As String, Fichier As String, Nom As String
Dim NewLig As Long, N As Long
Dim Repertoire As FileDialog
Dim Wb As Workbook
Dim Plage
 
Application.ScreenUpdating = False
Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
Repertoire.Show
Chemin = Repertoire.SelectedItems(1)
 
Fichier = Dir(Chemin & "\" & "*.xls")
Do While Fichier <> ""
    Set Wb = Workbooks.Open(Chemin & "\" & Fichier)
    With Wb.Worksheets(1)
        N = .Cells(.Rows.Count, 1).End(xlUp).Row
        Plage = .Range("A1").Resize(N, 7)
    End With
 
    Nom = Wb.Name
    Wb.Close False
    Set Wb = Nothing
 
    With ThisWorkbook.Worksheets("Feuil1")
        NewLig = .Cells(.Rows.Count, 4).End(xlUp).Row + 1
        .Range("D" & NewLig).Resize(N, 7).Value = Plage
        .Range("A" & NewLig).Resize(N) = Replace(Nom, ".xls", "")
    End With
    Fichier = Dir()
Loop
Set Repertoire = Nothing
MsgBox "Terminé"
End Sub

[Lyndils]

Bonjour,

Bon ton programme fonctionne parfaitement! Vous n'êtes pas seniors VBA pour rien!
Bien joué!

Je vais étudier ton programme et voir ce qui peut clocher dans le miens.

Encore merci!
Tu peux mettre résolu.

A la prochaine!

Lyndils