Discussion :

[lgair]

Bonjour,

Je souhaiterai copier un cellule ou une plage de cellule definie d'un classeur fermé, dans la page actuelle à l'aide d'un bouton macro.
J'ai déjà le code suivant qui fonctionne mais copie toute les données du classeur source et je voudrais pouvoir choisir qu'une seule cellule.
Je suis débutant dans ce domaine, merci pour votre aide.

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
Sub importer()
 Dim Source As Object
 Dim Rst As Object
 Dim ADOCommand As Object
 Dim Chemin As String, Cellule As String, Feuille As String
 Dim Cellule2 As String, Fichier As String
 
'------------------------------------------------------------------------
'---------Importation Données depuis Classeur Fermé------------
'------------------------------------------------------------------------
 
 'Plage variable des cellules contenant les données à récupérer dans le classeur fermé
 'Variabilité de la plage obtenue par une commande Concatener dans la feuille actuelle
 Cellule = Range("L35:L35")
 
   'Pour une plage de cellules, utilisez: Cellule = "A4:C10" et une simple cellule : cellule = "A4"
 
 'Nom de la feuille ou onglet variable ciblé dans le classeur fermé
 'Variabilité de la feuille obtenue par une commande Concatener dans la feuille actuelle
 Feuille = "B1150$"
   'N'oubliez pas d'ajouter $ au nom de la feuille.
   'Pour une feuille connue, utilisez : Feuille = "Exemple$"
 
 'Chemin complet et variable du classeur fermé
 'Variabilité obtenue par une commande Concatener dans la feuille actuelle
 Chemin = Range("M04").Value
   'Pour un chemin unique défini, utilisez : Chemin = "C:\Utilisateur\Bureau\Test.xls"
 
 'Instance LateBinding pour connexion au classeur fermé sans activation préalable
 'de Microsoft ActiveX Data Objects 2.0 Library
 Set Source = CreateObject("ADODB.Connection")
    Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & Chemin & _
        ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1;"";" '
 
 Set ADOCommand = CreateObject("ADODB.Command")
 With ADOCommand
   .ActiveConnection = Source
   .CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
 End With
 
 Set Rst = CreateObject("ADODB.Recordset")
 Rst.Open ADOCommand, , 1, 3
   '1 = adOpenKeyset, 3 = adLockOptimistic
 
'Copie le contenu des cellules dans le classeur ouvert (actuel)
 Set Rst = Source.Execute("[" & Feuille & Cellule & "]")
 
 Range("M18").CopyFromRecordset Rst
   'Pour une plage de cellule connue, utilisez : Range("A4:C10").CopyFromRecordset Rst
 
 Rst.Close
 Source.Close
 Set Source = Nothing
 Set Rst = Nothing
 Set ADOCommand = Nothing
 
End Sub

[joe.levrai]

Bonjour,


par ici : http://silkyroad.developpez.com/VBA/...sFermes/#LIV-A

avant dernier code de cette partie du tutoriel

[lgair]

J'ai déjà essayer d'utiliser ce code qui ressemble au mieux mais il me renvoi un message d'erreur...
Et je ne vois pas comment faire

[joe.levrai]

Quel message d'erreur ? Sur quelle ligne ?

si tu changes les paramètres ADODB ? Les parties en gras

Code :

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

Source.Open "Provider = Microsoft.ACE.OLEDB.12.0;data source=" & LeFichier & ";extended properties=""Excel 12.0;HDR=YES"""

[lgair]

J'ai noté comme erreur "erreur de compilation"
"Type défini par l'utilisateur non défini"

[joe.levrai]

Tel qu'indiqué au début du tutoriel, les codes travaillent en liaison précoce et nécessitent d'activer la référence Microsoft ActiveX Data Objects x.x Library


Si tu veux éviter de cocher cette référence, ceci DOIT fonctionner :

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 extractionValeurCelluleClasseurFerme()
    Dim Source As Object
    Dim Rst As Object
    Dim ADOCommand As Object
    Dim Fichier As String, Cellule As String, Feuille As String
 
    Cellule = "C3:C3"
    Feuille = "TOTO$" 'n'oubliez pas d'ajouter $ au nom de la feuille.
    Fichier = "MonChemin"
 
    Set Source = CreateObject("ADODB.Connection")
    Source.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & Fichier & ";Extended Properties=""Excel 12.0;HDR=No;"";"
 
 
     Set ADOCommand = CreateObject("ADODB.Command")
    With ADOCommand
        .ActiveConnection = Source
        .CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
    End With
 
 
    Set Rst = CreateObject("ADODB.recordset")
        Rst.Open ADOCommand, , 1, 3
    Set Rst = Source.Execute("[" & Feuille & Cellule & "]")
 
    Range("A2").CopyFromRecordset Rst
        Rst.Close
 
    Source.Close
    Set Source = Nothing
    Set Rst = Nothing
    Set ADOCommand = Nothing
End Sub

[Marc-L]

Bonjour !

je voudrais pouvoir choisir qu'une seule cellule.

En fait tu aurais pu déjà trouver la solution en le faisant manuellement
car cela fait partie des fonctions de base d'une feuille de calculs !
Une formule avec liaison, reproduisible aussi en VBA si vraiment nécessaire …

_________________________________________________________________________________________________________
Je suis Paris, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

[joe.levrai]

lire le début de la section vers lequel le lien que j'ai fourni pointe

[lgair]

Parfait cela fonctionne !

Merci beaucoup.

Le but est de récupérer plusieurs cellules d'un classeur sur un onglet donné et de le recopier sur un autre classeur à un autre endroit, le seul lien entre ces deux classeurs est que les deux classeurs ont des onglets nommé de la même façon.
Donc maintenant je pensais faire varier ma variable source et destination avec une boucle non ?

Tel qu'indiqué au début du tutoriel, les codes travaillent en liaison précoce et nécessitent d'activer la référence Microsoft ActiveX Data Objects x.x Library


Si tu veux éviter de cocher cette référence, ceci DOIT fonctionner :

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 extractionValeurCelluleClasseurFerme()
    Dim Source As Object
    Dim Rst As Object
    Dim ADOCommand As Object
    Dim Fichier As String, Cellule As String, Feuille As String
 
    Cellule = "C3:C3"
    Feuille = "TOTO$" 'n'oubliez pas d'ajouter $ au nom de la feuille.
    Fichier = "MonChemin"
 
    Set Source = CreateObject("ADODB.Connection")
    Source.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & Fichier & ";Extended Properties=""Excel 12.0;HDR=No;"";"
 
 
     Set ADOCommand = CreateObject("ADODB.Command")
    With ADOCommand
        .ActiveConnection = Source
        .CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
    End With
 
 
    Set Rst = CreateObject("ADODB.recordset")
        Rst.Open ADOCommand, , 1, 3
    Set Rst = Source.Execute("[" & Feuille & Cellule & "]")
 
    Range("A2").CopyFromRecordset Rst
        Rst.Close
 
    Source.Close
    Set Source = Nothing
    Set Rst = Nothing
    Set ADOCommand = Nothing
End Sub

[joe.levrai]

Quel intérêt de le faire sur le classeur fermé ?

autant l'ouvrir en lecture seule, récupérer ce qu'on veut, et le refermer


sinon, il te faut découper ta procédure en 4 parties :

1) Une procédure qui ouvre la connexion
2) Une procédure qui ferme la connexion
3) Une fonction qui exécute la requête SQL fournie et qui retourne la valeur de la cellule
4) Une procédure maître qui fourni les éléments aux autres procédures/fonctions et qui les appelle en boucle

Ca évitera d'ouvrir et fermer X connexions pour rien

un exemple (pas propre) basé sur l'un de mes projets (que je n'ai jamais eu le temps de remettre au propre), qui en revanche ne récupère pas une cellule mais fait une vraie requête en bonne et due forme (=peut récupérer entre 0 et 1 millions de résultats)

tu adapteras si c'est ton souhait

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
Public Const LeFichier As String = "MonChemin"
Public Const LaFeuille As String = "MaFeuille"
Public Source As Object
 
Sub OuvertureConnexion()
    Set Source = CreateObject("ADODB.Connection")
    Source.Open "Provider = Microsoft.ACE.OLEDB.12.0;data source=" & LeFichier & ";extended properties=""Excel 12.0;HDR=YES"""
End Sub
 
Sub FermetureConnexion()
    Source.Close
End Sub
 
Function requeteSQL(ByVal Fichier As String, ByVal xSQL As String) As Variant
    Dim Requete As Object
    Set Requete = Source.Execute(xSQL)
 
    With Requete
        If .EOF Then Exit Function Else requeteSQL = Application.Transpose(.getrows)
        .Close
    End With
End Function
 
Sub DesTestsSQL()
Dim LaRequete As String
Dim Tabl As Variant
 
OuvertureConnexion
 
ActiveSheet.Cells.Delete
LaRequete = "SELECT FORMAT(DATE, 'yyyy-mm-dd') AS DATE_ACTIVITE,AGENT,SUM(QUANTITE) AS PRODUCTIVITE " & _
            "FROM [" & LaFeuille & "$] " & _
            "GROUP BY DATE,AGENT " & _
            "ORDER BY DATE,AGENT"
 
Tabl = requeteSQL(LeFichier, LaRequete)
If Not IsArray(Tabl) Then
    MsgBox "aucun résultat"
Else
    Cells(2, 1).Resize(UBound(Tabl, 1), UBound(Tabl, 2)).Value = Tabl
End If
 
FermetureConnexion
 
End Sub

[Marc-L]

Le but est de récupérer plusieurs cellules d'un classeur sur un onglet donné et de le recopier sur un autre classeur à un autre endroit

Via une simple formule de calculs donc sans code, le B-A-BA d'Excel …

[lgair]

Merci beaucoup pour ces conseils.
Mais l'ouvrir n'est pas une solution pour moi car il faudrait que je l'ouvre trop souvent et ce sera une perte de temps à force.

Quel intérêt de le faire sur le classeur fermé ?

autant l'ouvrir en lecture seule, récupérer ce qu'on veut, et le refermer


sinon, il te faut découper ta procédure en 4 parties :

1) Une procédure qui ouvre la connexion
2) Une procédure qui ferme la connexion
3) Une fonction qui exécute la requête SQL fournie et qui retourne la valeur de la cellule
4) Une procédure maître qui fourni les éléments aux autres procédures/fonctions et qui les appelle en boucle

Ca évitera d'ouvrir et fermer X connexions pour rien

un exemple (pas propre) basé sur l'un de mes projets (que je n'ai jamais eu le temps de remettre au propre), qui en revanche ne récupère pas une cellule mais fait une vraie requête en bonne et due forme (=peut récupérer entre 0 et 1 millions de résultats)

tu adapteras si c'est ton souhait

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
Public Const LeFichier As String = "MonChemin"
Public Const LaFeuille As String = "MaFeuille"
Public Source As Object
 
Sub OuvertureConnexion()
    Set Source = CreateObject("ADODB.Connection")
    Source.Open "Provider = Microsoft.ACE.OLEDB.12.0;data source=" & LeFichier & ";extended properties=""Excel 12.0;HDR=YES"""
End Sub
 
Sub FermetureConnexion()
    Source.Close
End Sub
 
Function requeteSQL(ByVal Fichier As String, ByVal xSQL As String) As Variant
    Dim Requete As Object
    Set Requete = Source.Execute(xSQL)
 
    With Requete
        If .EOF Then Exit Function Else requeteSQL = Application.Transpose(.getrows)
        .Close
    End With
End Function
 
Sub DesTestsSQL()
Dim LaRequete As String
Dim Tabl As Variant
 
OuvertureConnexion
 
ActiveSheet.Cells.Delete
LaRequete = "SELECT FORMAT(DATE, 'yyyy-mm-dd') AS DATE_ACTIVITE,AGENT,SUM(QUANTITE) AS PRODUCTIVITE " & _
            "FROM [" & LaFeuille & "$] " & _
            "GROUP BY DATE,AGENT " & _
            "ORDER BY DATE,AGENT"
 
Tabl = requeteSQL(LeFichier, LaRequete)
If Not IsArray(Tabl) Then
    MsgBox "aucun résultat"
Else
    Cells(2, 1).Resize(UBound(Tabl, 1), UBound(Tabl, 2)).Value = Tabl
End If
 
FermetureConnexion
 
End Sub

[Invité]

Bonsoir,
Puisque tu utilises l'objet command un exécute suffit!

Code :

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

set rs = ADOCommand.execute

Maintenant si tu veux récupérer une valeur utilise un close where et l'objet parameteur puisque tu utilise l'objet commande.

[Marc-L]

Mais l'ouvrir n'est pas une solution pour moi

Une formule de calculs avec liaison, c'est à dire le signe = accompagné de juste l'adresse de la cellule dans l'autre classeur
n'a pas besoin d'avoir le classeur ouvert que ce soit directement dans la feuille de calculs comme par code …

[lgair]

Oui cette solution est facile au premier abord, mais cela implique que je cherche toujours la même info au même endroit pour un onglet donné, non ?
Or dans mon cas, on part d'un onglet vierge qui est dupliqué selon des renseignements inscrit dans cet onglet et à ce momment là il va chercher dans un autre onglet d'un autre classeur les infos necessaires.
Et cela pose aussi problème si le classeur source change de place, il faut tout reprendre, non ?

[lgair]

Voici mon code qui fonctionne, si quelqu'un à une idée pour l'améliorer ?
Le rendre plus rapide :-)
Merci

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
Sub importer()
    Dim Source As Object
    Dim Rst As Object
    Dim ADOCommand As Object
    Dim Fichier As String, Cellule As String, Feuille As String, Destination As String
    Dim i As Integer, j As Integer
    Dim Table(2, 1) As String
 
    ' Numéro de lot avec dollar Range("B26").Value & "$"
    Feuille = Range("B26").Value & "$"
 
    ' Lieu de stockage du fichier source
    Fichier = Range("M07").Value
 
 
    Set Source = CreateObject("ADODB.Connection")
    Source.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & Fichier & ";Extended Properties=""Excel 12.0;HDR=No;"";"
 
        Set ADOCommand = CreateObject("ADODB.Command")
 
    ' Tableau contenant les cellules à copiées Table(x,0) et leur destination Table(x,1)
    Table(1, 0) = "L35:L35"
    Table(1, 1) = "M17"
    Table(2, 0) = "N38:N38"
    Table(2, 1) = "M18"
 
  For i = 1 To 2
 
    With ADOCommand
        .ActiveConnection = Source
        .CommandText = "SELECT * FROM [" & Feuille & Table(i, 0) & "]"
    End With
 
 
    Set Rst = CreateObject("ADODB.recordset")
        Rst.Open ADOCommand, , 1, 3
    Set Rst = Source.Execute("[" & Feuille & Table(i, 0) & "]")
 
    Range(Table(i, 1)).CopyFromRecordset Rst
        Rst.Close
 
    Next i
 
    Source.Close
    Set Source = Nothing
    Set Rst = Nothing
    Set ADOCommand = Nothing
 
End Sub

[Marc-L]

Oui cette solution est facile au premier abord, mais cela implique que je cherche toujours la même info au même endroit pour un onglet donné, non ?
Or dans mon cas, on part d'un onglet vierge qui est dupliqué selon des renseignements inscrit dans cet onglet et à ce momment là il va chercher dans un autre onglet d'un autre classeur les infos necessaires.
Et cela pose aussi problème si le classeur source change de place, il faut tout reprendre, non ?

Non et non aux deux questions car par code la formule peut être paramétrée comme dans ta procédure en une ligne de code !
C'est la solution la plus simple pour ceux ne s'en sortant pas avec ADODB.

ADODB s'avère utile lorsqu'il y a plusieurs critères d'extraction ce qui n'est apparemment pas le cas ici.
Ou encore pour extraire un bloc de cellules …

[Invité]

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
Sub importer()
Dim Rst As Object
Dim Fichier As String, Cellule As String, Feuille As String, Destination As String
Dim i As Integer, j As Integer
dim Table 
Feuille = Range("B26").Value & "$": Fichier = Range("M07").Value
    ' Lieu de stockage du fichier source
 Table = Array(Array("L35:L35", "N38:N38"), Array("M17", "M18"))
  With CreateObject("ADODB.Connection")
    .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";Extended Properties=""Excel 12.0;HDR=No;"";"
    For i = 0 To 1
        Set Rst = .Execute("SELECT * FROM [" & Feuille & Table(0)(i) & "]")
        Range(Table(1)(i)).CopyFromRecordset Rst
        Rst.Close
    Next
    .Close
End With
End Sub

[lgair]

Merci beaucoup c'est super !
Une idée pour rajouter une fonction qui me permet de transposer un un groupe de Céline en les copiant , ;-)
Merci

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
Sub importer()
Dim Rst As Object
Dim Fichier As String, Cellule As String, Feuille As String, Destination As String
Dim i As Integer, j As Integer
dim Table 
Feuille = Range("B26").Value & "$": Fichier = Range("M07").Value
    ' Lieu de stockage du fichier source
 Table = Array(Array("L35:L35", "N38:N38"), Array("M17", "M18"))
  With CreateObject("ADODB.Connection")
    .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";Extended Properties=""Excel 12.0;HDR=No;"";"
    For i = 0 To 1
        Set Rst = .Execute("SELECT * FROM [" & Feuille & Table(0)(i) & "]")
        Range(Table(1)(i)).CopyFromRecordset Rst
        Rst.Close
    Next
    .Close
End With
End Sub