Bonjour,
J'avais besoin de récupérer une ligne de donnée précise dans des classeurs servant de base de données (issues de différentes applis internes) : 1 classeur par type de base et par année (contenu : code de la donnée + 1 colonne par mois plus le cumul annuel) .
J'avais 4 paramètres à gérer : le code de la donnée, la succursale initiatrice, l'année voulue et le mois recherché.

Ayant trouvé dans le tutoriel : "lire et écrire dans les classeurs fermés", la méthode pour y accéder de manière dynamique, j'ai créé ma macro complémentaire et l'ai utilisé dans des tableaux de bord assez conséquent
(5000 appels de la fonction par tableau environ).

Cela a bien fonctionné. Le problème vient du temps de réponse : 6 secondes par appel (les bases et les tableaux de bord sont sur le même serveur). En délocalisant (bases et tableau sur mon pc), je gagne un peu de temps mais cela reste encore trop long.
Quelqu'un aurait une idée ?

Voici mon 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
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
Dim cn As ADODB.Connection
Dim fichier As String
Dim rst As ADODB.Recordset
Dim extension As String
Dim texte_sql As String
Dim i As Integer
Dim srange As String
Dim base As String
 
'définit le classeur fermé servant de base de données
 
If Len(codeARech) = 10 Then  'ou va ouvrir la base SASTA
   base = "SASTA"
 
Else
    If Len(codeARech) = 6 Then
        base = "CASAC"
    Else
        'MsgBox "Code erroné" & codeARech, vbCritical, "OUPS"
        XRECHERCHEV = "E1"
        Exit Function
    End If
End If
fichier = rechbase(annee, base) 'récupère le nom du classeur à ouvrir
Set cn = New ADODB.Connection
 
'connection
With cn
     .Provider = "Microsoft.jet.oledb.4.0"
    .ConnectionString = "provider=microsoft.ACE.OLEDB.12.0;data source=" & fichier & ";Extended Properties=""excel 12.0;HDR=YES;"""
    .Open
End With
'ouverture recordset
Set rst = New ADODB.Recordset
texte_sql = "SELECT * FROM [" & ua & "$]" & _
            " WHERE code = '" & codeARech & "'"
Set rst = cn.Execute(texte_sql)
 
 
'Sheets("feuil1").Activate
'tester si la requête n'est pas vide
If rst.EOF = True Then
     XRECHERCHEV = "E2"
    GoTo fin
Else
    If IsNull(rst.Fields(moisSousRevue)) Then
        XRECHERCHEV = ""
    Else
        'on retourne la valeur du mois sous revue convertie en numérique (pour cadrage à droite et pallier les données  textes renvoyées par sasta
        XRECHERCHEV = CDbl(rst.Fields(moisSousRevue))
    End If
 
End If
 
fin:
'fermeture connection et recordset
rst.Close
cn.Close
Set cn = Nothing
Set rst = Nothing
 
End Function