Discussion :

[weyb06]

(re)bjr à tous,

j'ai un module vba qui recherche un nom dans un fichier xlsx et qui renvoie VRAI ou FAUX selon le cas.

Au 1er appel du module, c'est nickel, mais au suivant, ca plante avec "l'indice n'appartient pas à la sélection" sur :

Code :

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

1
2
    ActiveWorkbook.Worksheets(1).ListObjects("effectifHbx").Sort. _
        SortFields.Clear

je vous mets le code en entier, précédé de l'appel.

1er appel :

Code :

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

1
2
3
                            If Not Application.Run("'PERSONAL.XLSB'!Check_Effectifs", Nom_Presta, FirstSearch) Then 'si vérif est false
                                GoTo errorPrestaNameHandler
                            End If

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
Public Function Check_Effectifs(Nom_Presta As String, FirstSearch As Boolean) As Boolean
 
    '-------------------------------
 
Dim Effectifs_FullFileName As String
Dim fich As Object
Dim Trouve As Range, PlageDeRecherche As Range
'Dim Valeur_Cherchee As String, AdresseTrouvee As String
Dim estouvert As Boolean
 
    Effectifs_FullFileName = "Tdb_Effectifs.xlsx"
    Sheets(1).Select
 
    If FirstSearch Then 'si on est à la 1ere rech. on check l'ouverture du xls
 
        'test si le classeur est ouvert
        estouvert = False
        For Each fich In Workbooks
            'Debug.Print fich.Name
            If fich.Name = Effectifs_FullFileName Then estouvert = True
        Next
        If estouvert = False Then
            If FileDateTime("C:\fichiersxls\" & Effectifs_FullFileName) < Date Then
                MsgBox ("les fichiers shpt n'ont pas été copiés en local ! :-(")
                'ChDir "C:\fichiersxls"
                Exit Function
            Else
                Workbooks.Open filename:="C:\fichiersxls\" & Effectifs_FullFileName, UpdateLinks:=0
            End If
        End If
    End If
 
    'Effectifs
    Windows(Effectifs_FullFileName).Activate
 
    'supp filtres éventuels
    Range("A1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    Range("A1").Select
    Selection.AutoFilter
 
    ActiveWorkbook.Worksheets(1).ListObjects("effectifHbx").Sort. _
        SortFields.Clear
    ActiveWorkbook.Worksheets(1).ListObjects("effectifHbx").Sort. _
        SortFields.Add Key:=Range("effectifHbx[[#All],[Nom]]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(1).ListObjects("effectifHbx"). _
        Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
    Set PlageDeRecherche = ActiveSheet.Columns(1)
 
    'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
    Set Trouve = PlageDeRecherche.Cells.Find(what:=Nom_Presta, lookat:=xlWhole)
 
    'traitement de l'erreur possible : Si on ne trouve rien :
    If Trouve Is Nothing Then
        'ici, traitement pour le cas où la valeur n'est pas trouvée
        'AdresseTrouvee = Nom_Presta & " n'est pas présent dans " & PlageDeRecherche.Address
        Check_Effectifs = False
    Else
        'ici, traitement pour le cas où la valeur est trouvée
        'AdresseTrouvee = Trouve.Address
        Check_Effectifs = True
        Cells.Find(what:=Nom_Presta, lookat:=xlWhole).Select
    End If
    'MsgBox AdresseTrouvee
    'vidage des variables
    Set PlageDeRecherche = Nothing
    Set Trouve = Nothing
 
 
End Function

comme ca ne trouve pas le nom, ca va à l'étiquette "errorPrestaNameHandler" :

Code :

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

1
2
3
4
5
errorPrestaNameHandler:
    'MsgBox ("Le nom du prestataire " & Nom_Presta & " n'est pas correct.")
    continuer = MsgBox("Le nom du prestataire " & Nom_Presta & " n'est pas correct." & vbCrLf & "voulez-vs continuer ?", vbYesNo, Admin)
    If continuer = vbNo Then Exit Sub
    GoTo SaisiePresta

je dis "ok", ca va à l'étiquette "SaisiePresta" où là, comme son nom l'indique, on saisit un prestataire :-)
ensuite j'appelle une 2e fois le module... et ca plante à la ligne 43 :-(

pour paraphraser le père d'Amélie Poulain : "je ne comprends pas"...

Un énorme MERCI d'avance pour vos lumières !!!

cordt

[goldstar]

Bonjour,

Je penses qu'il faut que tu active ton classeur à partir duquel tu lance ta procédure

Code :

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

1
2
3
4
5
6
7
 
 
'ligne à ajouter
Windows(nomDeTonClasseur).Activate
 
ActiveWorkbook.Worksheets(1).ListObjects("effectifHbx").Sort. _
        SortFields.Clear

Cordialement,

[weyb06]

bsr,

cette ligne s'y trouve déjà à la ligne 34
ca ne va pas ?

cordt

[RyuAutodidacte]

Bonsoir,
regarde cela, peut être que tu y trouveras ta réponse : https://msdn.microsoft.com/fr-fr/lib...ffice.14).aspx

[weyb06]

bonsoir,

alors j'ai suivi le dernier conseil, et comme "effectifs.xls" a déjà un tableau qui est nommé "effectifHbx", j'ai donc désormais :

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
Dim lo As ListObject
 
    'Set lo = ActiveWorkbook.Worksheets(1).ListObjects.Add( _
     SourceType:=xlSrcRange, _
     Source:=Range("A1:ab300"), _
     XlListObjectHasHeaders:=xlYes)
    'lo.Name = "SampleData"
     Set lo = ActiveWorkbook.Worksheets(1).ListObjects("effectifHbx") '<-------------- j'ai du modifier cette ligne -----------------
 
    Dim so As Sort
    With lo.Sort
        With .SortFields
            .Clear
            .Add Range("effectifHbx[[#All], [Nom]]"), SortOn:=xlSortOnValues, Order:=xlAscending
        End With
        .Header = xlYes
        .Orientation = xlSortColumns
        .Apply
    End With
 
    Set PlageDeRecherche = ActiveSheet.Columns(1)
 
    'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
    Set Trouve = PlageDeRecherche.Cells.Find(what:=Nom_Presta, lookat:=xlWhole)
 
    ...
 
    ' Delete the List object so you can run the code again if you like.
    lo.Delete

mais souci : ca supprime le tableau du fichier !!!!


au début je nommais le tableau "SampleData" comme dans l'exemple.
comme j'utilise le fichier de qq d'autre et que le tableau est déjà nommé, j'ai eu "erreur 1004 : un tableau ne peut pas en chevaucher un autre", et je dois donc "utiliser" le nom du tableau "effectifHbx" - d'où la ligne modifiée...

et donc, le supprimer à la fin, ce n'est pas trop ce que je voulais faire puisque j'en ai besoin pour la recherche suivante...

une solution "bourrin" serait de fermer le fichier à la fin de chaque recherche, et de l'ouvrir à la suivante...

mais on perd du coup l'intérêt de cette solution...
-->y a-t-il plus sioux ???

cordt

[RyuAutodidacte]

Bonjour,

Je vois que tu n'as plus l'erreur de début.
En revanche pour le nouveau problème, je te conseille de faire le code en pas à pas avec la touche F8 du clavier en affichant préalablement la fenêtre des variables locales afin de suivre ce qu'il se passe dans ton code
L'exemple du site de M$ est censé être bon, il y a sûrement une erreur de logique de ta part

Comme tu t'en doute, l'aide est bénévole et le temps est précieux, pour moi tout n'étant pas clair (et je suis loin d'être un caddor), il est très conseillé de donner une explication claire et exhaustive avec les tenants et aboutissants et le but final (pour tout le monde), tous les détails comptent.
Ce sera plus simple et sûrement que l'on pourra t'orienter vers une solution/des conseils plus adéquate(s).