Discussion :

[SilkyRoad]

bonjour

Code :

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

1
2
 Dim Rst As ADODB.Recordset
 Dim ADOCommand As ADODB.Command

Tu dois également les déclarer en type Object et ensuite utiliser la commande CreateObject. par exemple :

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
Function LireCellule_ClasseurFerme( _
        Chemin As String, _
        Fichier As String, _
        Feuille As String, _
        Cellule As Variant) As Variant
 
    Application.Volatile
 
    Dim Source As Object, Rst As Object, ADOCommand As Object
    Dim Cible As String
 
    Feuille = Feuille & "$"
    Cible = Cellule.Address(0, 0, xlA1, 0) & ":" & _
        Cellule.Address(0, 0, xlA1, 0)
 
    Set Source = CreateObject("ADODB.Connection")
    Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & Chemin & "\" & Fichier & _
        ";Extended Properties=""Excel 8.0;HDR=No;"";"
 
    Set ADOCommand = CreateObject("ADODB.Command")
    With ADOCommand
        .ActiveConnection = Source
        .CommandText = "SELECT * FROM [" & Feuille & Cible & "]"
    End With
 
    Set Rst = CreateObject("ADODB.Recordset")
    '1 = adOpenKeyset, 3 = adLockOptimistic
    Rst.Open ADOCommand, , 1, 3
    Set Rst = Source.Execute("[" & Feuille & Cible & "]")
 
    LireCellule_ClasseurFerme = Rst(0).Value
 
    Rst.Close
    Source.Close
    Set Source = Nothing
    Set Rst = Nothing
    Set ADOCommand = Nothing
End Function

bonne journée
michel

[demongin]

Bonjour,

Un très grand merci à toi, ça marche impeccable !!
Et un obstacle passé, Un !
Phase 2 du développement du code lancée...

J'espère que plus rien ne m'arrêtera maintenant.....

[AlainTech]

ça marche impeccable !!

Un petit clic sur le bouton ?

Merci

[demongin]

Un petit clic sur le bouton ?

Merci

Oui, bien sûr ! mais je voudrai finir la totalité de mon code pour l'afficher ici. La réponse ci-dessus ne concernait qu'un point du post initial.

[demongin]

Bonjour,

Je viens de me rendre compte en testant mon code que l'importation fonctionne idéalement mais elle copie les formules et je souhaiterai seulement importer les résultats.
Avez-vous une idée ?

Ci-joint mon code quasiment achevé. L'incrémentation d'une cellule ne marche pas à la fin, sans raison apparente puisqu'il fonctionne lorsqu'il est seul ! là aussi, si vous avez une idée, je suis preneur...

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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
 
Sub FichierEASuivant()
 Dim Source As Object
 Dim Rst As Object
 Dim ADOCommand As Object
 Dim Chemin As String, Cellule As String, Feuille As String
 Dim Chemin2 As String, Fichier As String
 
'------------------------------------------------------------------------
'----------Copie + Incrémentation du Classeur et de la Feuille-----------
'------------------------------------------------------------------------
 
'Chemin variable de destination du fichier copié obtenu par la commande Concatener
Chemin2 = Range("A11").Value
'Nom variable du fichier à copier obtenu par la commande Concatener
Fichier = Range("A15").Value & ".xls"
 
'Vérifie que le fichier n'existe pas et interroge l'utilisateur si Oui
If Dir(Chemin2 & Fichier) <> "" Then  'le fichier existe
    If MsgBox("Ce fichier existe déjà ! Voulez vous le remplacer ?", vbYesNo) <> vbYes Then Exit Sub
    Application.DisplayAlerts = False
End If
    'Copie le fichier à l'emplacement spécifié
    ActiveWorkbook.SaveCopyAs Chemin2 & Fichier
    Application.DisplayAlerts = True
 
'Ouvre le fichier copié
Application.Workbooks.Open Chemin2 & Fichier
 
'Incrémante le nom de la feuille de 1
Sheets(Range("A16").Value).Select
Sheets(Range("A16").Value).Name = Range("A15").Value
 
'Bascule sur le fichier source toujours ouvert
Workbooks(Range("A16").Value & ".xls").Activate
 
'Force Excel a quitter le fichier source sans sauvegarder
  'Si le fichier source reste ouvert les importations commandées par
  'la macro ExtractionValeurCelluleClasseurFerme ne marchera pas
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
 
'Excel active par défaut le fichier copié (le seul ouvert)
 
 
'------------------------------------------------------------------------
'---------Importation Données depuis Classeur Précédent 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("A14").Value
   '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 = Range("E11").Value
   '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("A12").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(Range("A14").Value).CopyFromRecordset Rst
   'Pour une plage de cellule connue, utilisez : Range("A4:C10").CopyFromRecordset Rst
 
'Incrémentation d'une cellule de 1
 Range("C11") = Range("C11").Value + 1
 
 Rst.Close
 Source.Close
 Set Source = Nothing
 Set Rst = Nothing
 Set ADOCommand = Nothing
 
End Sub

[demongin]

Re-bonjour,

En fait, il n'y a aucun problème avec l'importation. J'ai trouvé le problème mais je n'ai pas encore trouvé la solution :
L'exécution du code s'arrête avant de commencer l'importation des données, c'est à dire après avoir fermé le classeur précédent.
C'est donc la même chose pour la dernière étape.

La solution doit être toute bête, j'ai essayé de recouper le code et d'appeler chacune des parties mais sans succès.

Pouvez-vous m'aider s'il vous plait ?

[demongin]

Bonsoir,

Il est temps que la nuit ma porte conseil, car après une bonne centaine d'essai et de variante, je cale.
Il est certain à présent avec le mode pas à pas que le code s'interrompt après la fermeture du premier classeur.
Pour remédier à cela, j'ai notamment essayé de ne pas activer le classeur source comme je le faisais initialement pour le fermer, mais de rester sur le nouveau classeur et d'utiliser la commande ci-dessous :
Le classeur source se ferme, le classeur copié reste ouvert, mais le code ne se poursuit pas !!!

En espérant que cela sera plus facile pour m'aider...

Code :

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

1
2
 
Workbooks(Range("A16").Value & ".xls").Close Savechanges:=False

[demongin]

Bonsoir,

Je me répond et je dois dire que la solution était très simple :
- Découper le code en 2 parties distinctes
- Attribuer au seconde des touches de raccourcis depuis les options de la macro : ex. : ctrl + t
- Appeler la macro par ces mêmes touches depuis la première partie de code : ex. : SendKeys "^t"

Voilà ce que cela donne avec une instruction de vérification de l'état du classeur car il ne doit pas avoir été modifié depuis son ouverture pour que la procédure ne s'interrompe pas par la boite de dialogue automatique de sauvegarde.
J'ai utilisé la commande MsgBoxEx pour élaborer une boite de dialogue personnalise et cela demande de copier le code suivant dans un nouveau module : http://arkham46.developpez.com/artic...xplus/doc/#LVI.

Une deuxième instruction vérifie si un classeur ayant le même nom une fois incrémenté existe avant sa copie.

Voici les deux codes :

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
Sub NouveauEA()
 Dim Chemin2 As String, Fichier As String
 Dim Rep As Long
 Dim ltexte As String
 
'------------------------------------------------------------------------
'----------Copie + Incrémentation du Classeur et de la Feuille-----------
'------------------------------------------------------------------------
 
'Chemin variable de destination du fichier copié obtenu par la commande Concatener
Chemin2 = Range("A11").Value
'Nom variable du fichier à copier obtenu par la commande Concatener
Fichier = Range("A15").Value & ".xls"
 
'Texte rtf incluant la mise en forme servant à la boite de dialogue suivante
ltexte = "{\rtf1\ansi\ansicpg1252\deff0\deflang1036{\fonttbl{\f0\fdecor\fprq2\fcharset0 Stencil;}{\f1\fswiss\fcharset0 Arial;}{\f2\fswiss\fprq2\fcharset0 Verdana;}{\f3\fnil\fprq2\fcharset2 SansSerif;}}" & _
    "{\colortbl ;\red255\green0\blue0;\red0\green0\blue255;\red0\green255\blue0;}" & _
    "{\*\generator Msftedit 5.41.15.1515;}\viewkind4\uc1\pard\qc\cf1\ul\b\f0\fs44 ATTENTION !\par" & _
    "\cf0\ulnone\b0\f1\fs20\par" & _
    "\f2\fs28 L'Etat d'Acompte servant de base \'e0 l'\'e9tablissement de la \par" & vbCrLf & _
    "prochaine situation de travaux a \'e9t\'e9 modifi\'e9 depuis son ouverture !\par" & vbCrLf & _
    "\par" & vbCrLf & _
    "\cf2\ul Vous devez le sauvegarder pr\'e9alablement pour pouvoir continuer.\par" & vbCrLf & _
    "\cf0\ulnone\par" & vbCrLf & _
    "\b Cette action sera irr\'e9versible,\par" & vbCrLf & _
    "\b0\par" & vbCrLf & _
    "En cas de doute, choisissez \b Non\b0  et controlez si les modifications doivent-\'eatre enregistr\'e9es.\par" & vbCrLf & _
    "\f3\par" & vbCrLf & _
    "\cf3\b\f0\fs40 ENREGISTRER ou NON ?\par" & vbCrLf & _
    "\par" & vbCrLf & _
    "}"
 
'Vérifie que le fichier source a été modifié depuis son ouverture (largeur de la boite fixée à 700 pixels)
If Not ThisWorkbook.Saved Then
    Rep = MsgBoxEx(ltexte, vbCritical + vbYesNo, , , , , 700)
     If Rep = vbNo Then
        Exit Sub
      Else
        ThisWorkbook.Save
    End If
End If
 
'Vérifie que le fichier cible n'existe pas et interroge l'utilisateur si Oui
If Dir(Chemin2 & Fichier) <> "" Then  'le fichier existe
    If MsgBox("Ce fichier existe déjà ! Voulez vous le remplacer ?", vbYesNo) <> vbYes Then Exit Sub
    Application.DisplayAlerts = False 'Message de confirmation désactivé
End If
    'Copie le fichier à l'emplacement spécifié
    ActiveWorkbook.SaveCopyAs Chemin2 & Fichier
    Application.DisplayAlerts = True
 
'Ouvre le fichier copié
Application.Workbooks.Open Chemin2 & Fichier
 
'Incrémante le nom de la feuille de 1 sur le fichier copié
Sheets(Range("A16").Value).Select
Sheets(Range("A16").Value).Name = Range("A15").Value
 
'Lance la macro affectée au raccourcis Crtl+t
SendKeys "^t"
 
'Ferme le fichier source (False : sans sauvegarde / True : avec sauvegarde)
ThisWorkbook.Close
 
End Sub

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
Sub ImportationDonnees()
 Dim Source As Object
 Dim Rst As Object
 Dim ADOCommand As Object
 Dim Chemin As String, Cellule As String, Feuille As String
 
'------------------------------------------------------------------------
'---------Importation Données depuis Classeur Précédent 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("A14").Value
   '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 = Range("E11").Value
   '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("A12").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(Range("A14").Value).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
 
'Incrémentation d'une cellule de 1
 Range("C11") = Range("C11").Value + 1
 
End Sub