[XL-2003] données Excel à partir d'access: pb de déclenchement mise à jour

[debdev]

Bonjour à tous,

Je récupère des données depuis une requete SQL d'une base access.
J'ai pris le code dans le tuto Communication entre Access et Excel. ça fonctionne bien sauf pour la mise à jour des données.

Dans le tuto, la sub auto_open est utilisée, pour que les données se mettent à jour à l'ouverture du fichier excel. Chez moi, ça ne marche pas: il faut que je rentre dans la cellule où est inscrite la fonction retrieve et que je fasse "entrée" pour que la donnée se mette à jour.

Ceci étant dit, je ne souhaite pas que les données se mettent à jour à l'ouverture du classeur mais en appuyant sur un bouton. J'ai donc mis un bouton et j'ai affecté la sub UpdateData (j'ai juste changé le nom auto_open en updateData) mais ça ne marche pas non plus. Il faut toujours que je rentre dans la cellule où est inscrite la fonction retrieve et que je fasse "entrée" pour que la donnée se mette à jour.

Code :

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
 
'Sub UpdateData()
Sub auto_open()
    ' La sub auto_open possède la propriété d'être automatiquement
    '  exécutée à l'ouverture du classeur Excel
    '  à l'identique : auto_close est exécutée sur la fermeture
    Dim strPath As String
 
    ' Seule contrainte une cellule nommée strPath
    '  doit être présente dans le classeur et
    '  renvoyer sur le chemin de la base access
    Application.Goto Reference:="StrPath"
 
    strPath = ActiveCell
 
    ' Nous testons si le fichier est accessible
    If Len(Dir(strPath)) > 0 Then
        ' Déclaration de la variable de connexion
        Set cnx = New ADODB.Connection
        ' MsgBox "Connexion réussie"
        ' Connexion à la base
        ConnectDB cnx, strPath
    Else
        MsgBox "La base n'a pas pu être trouvée" & vbCrLf & _
                strPath & vbCrLf & _
                "n'est pas un chemin valide.", vbCritical + vbOKOnly
    End If
 
End Sub

Merci de votre aide

[debdev]

Bonjour,

J'ai fait d'autres tests qui n'ont pas rencontré le succès escompté...

Dans le code suivant, j'ai:
- dans un module: la sub auto_open, la sub ConnectDB et la fonction xretrieve.
- dans ThisWorkbook: la sub UpdateData où je fais un calculate de ma Range.

Remarque: sans les macros,
- si je fais shift+F9, rien ne se passe
- si je fais F2+entrée dans chaque cellule, le calcul se fait
Pourquoi ?

Module:

Code :

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
Public cnx As ADODB.Connection
 
Sub auto_open()
    Dim strPath As String
    Application.Goto Reference:="StrPath"
    strPath = ActiveCell
    If Len(Dir(strPath)) > 0 Then
        Set cnx = New ADODB.Connection
        ConnectDB cnx, strPath
    Else
        MsgBox "La base n'a pas pu être trouvée" & vbCrLf & _
                strPath & vbCrLf & _
                "n'est pas un chemin valide.", vbCritical + vbOKOnly
    End If
 
End Sub
 
 
Sub ConnectDB(ByRef cnx As ADODB.Connection, ByVal strPath As String)
    'Définition du pilote de connexion
    cnx.Provider = "Microsoft.Jet.Oledb.4.0"
    'Définition de la chaîne de connexion
    cnx.ConnectionString = strPath
    'Ouverture de la base de données
    cnx.Open
End Sub
 
 
Public Function xRetrieve(Optional ByVal whatEI As String = vbNullString, _
                          Optional ByVal Mois As Integer = 0)
    Dim rec As New ADODB.Recordset
    Dim strSQL As String
    strSQL = "SELECT countEI AS COMPTE_EI " & _
             "FROM [QueryEtat] WHERE 1=1 "
 
    If Len(whatEI) > 0 Then
        strSQL = strSQL & " and ([what] = '" & whatEI & "')"
    End If
    If Mois > 0 Then
        strSQL = strSQL & " And ([moisEI] = " & Mois & ")"
    End If
    Dim rst As New ADODB.Recordset
    rst.Open strSQL, cnx
    On Error GoTo errH01
    rst.MoveFirst
    xRetrieve = CDbl(rst("COMPTE_EI"))
    rst.Close
    Set rst = Nothing
    Exit Function
errH01:
    Err.Clear
    xRetrieve = 0
    rst.Close
    Set rst = Nothing
End Function

ThisWorkbook:

Code :

1
2
3
Sub UpdateData()
    Range("ListingValues").Calculate 'ListingValues est ma plage de valeurs
End Sub

Merci pour votre aide

[bbil]

Bonjour,

Pour ce qui est de la macro Auto_Open celle-ci n'est plus à utiliser ... utilise l'événement Open dans ThisWorkBook...

[Godzestla]

Bonjour,

pour qu'un code s'exécute automatique à l'ouverture d'un fichier, il doit être placé dans l'évènement Workbook_Open() qui doit être défini dans l'objet Thisworkbook et pas ailleurs.

Le code ci-dessous affiche bonjour à l'ouverture du classeur dans lequel il se trouve.

Code :

1
2
3
Private Sub Workbook_Open()
MsgBox("Bonjour")
End Sub

[debdev]

Merci pour vos réponses. Mais ce n'est pas exactement ce que je veux. Comme dit dans mon premier message, je ne souhaite pas que les données se mettent à jour à l'ouverture mais après un clic sur un bouton par l'utilisateur.

Mon bouton devrait déclencher la Sub UpdateData (mise dans ThisWorkbook). Mais rien ne se passe... Si je mets ce bout de code dans Module 1, rien ne se passe non plus.

Code :

1
2
3
Sub UpdateData()
    Range("ListingValues").Calculate
End Sub

Si je teste à l'ouverture du fichier, rien ne se passe non plus (Sub Workbook_Open mise dans ThisWorkbook), le reste du code étant mis dans Module 1:

Code :

1
2
3
4
5
Private Sub Workbook_Open()
    'MsgBox ("Bonjour")
    CheckDB 'la connexion à la base access se fait bien
    Range("ListingValues").Calculate 'rien ne se passe
End Sub

Si je bascule tout le code dans thisWorkbook, rien ne se passe non plus.


Donc que ce soit à l'ouverture du fichier ou bien après un clic sur un bouton, code mis dans ThisWorkbook ou dans Module 1, je n'arrive pas à reproduire l'équivalent du F2+entrée sur chaque cellule. Je n'arrive donc pas à executer la fonction inscrite dans la cellule (qui est la fonction retrieve prise dans le tuto). Le problème peut il venir de Range("ListingValues") ? Faut il mettre qch avant Range ?

Merci de votre aide.

[debdev]

Bonjour,

J'ai continué mes recherches sur internet mais je n'ai toujours pas trouvé de solution... Ce matin, je n'ai pas compris sur quoi j'ai cliqué mais ma macro s'est déclenchée et toutes les valeurs se sont mises à jour. Bien entendu, quand j'ai voulu recliquer sur mon bouton, plus rien ne marchait.

Avec le activate, ça ne marche pas.
Avec le SendKeys, ça marche mais pas sur les cellules que je veux !

Voici le code:

Code :

1
2
3
4
' dans ThisWorkbook
Private Sub Workbook_Open()
    CheckDB
End Sub

Code :

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
' dans Module 1
 
Public cnx As ADODB.Connection
 
Public Sub CheckDB()
 ' fonctionne: déclenche la procédure ConnectDB
End Sub
 
Sub ConnectDB(ByRef cnx As ADODB.Connection, ByVal strPath As String)
 ' fonctionne: connexion à la base de données
End Sub
 
Public Function xRetrieve(Optional ByVal whatEI As String = vbNullString, _
                          Optional ByVal Mois As Integer = 0)
 'fonctionne: met à jour la cellule dans excel à partir d'access
End Function
 
Sub UpdateData()
 'ne fonctionne pas
 'déclenchée par un clic sur un bouton dessiné par la boite à outil dessin (puis clic droit "affecter une macro")
 Range("ListingValues").Calculate 'ListingValues est le nom d'une plage de mon 1er onglet
End Sub
 
'OU
 
Sub UpdateData()
 'ne fonctionne pas
 'déclenchée par un clic sur un bouton dessiné par la boite à outil dessin (puis clic droit "affecter une macro")
 Dim Ws As Worksheet
 Dim Cell As Range
 Set Ws = Sheets(1)
 For Each Cell In Ws.Range("ListingValues") 'ça se déclenche sur je ne sais trop quelles cellules mais pas les bonnes en tout cas
  SendKeys "{F2}"
  SendKeys "{ENTER}"
 Next Cell
End Sub

Voilà, ma question est donc:
comment déclencher l'execution de la fonction personnalisée retrieve dans la plage dynamique ListingValues ?
Merci de votre aide