Discussion :

[pierrequimousse]

Bonjour à tous,

Je souhaiterais pouvoir copier le résultat d'une requête (ce résultat consiste en 1 enregistrement de 8 champs) dans le presse papier, afin que mes utilisateurs puissent coller les valeurs des 8 cellules dans leur tableau (je ne souhaite pas automatiser le collage, le tableau excel doit rester indépendant).

Comme je ne souhaite pas lier mon tableur excel je ne peux pas utiliser "DoCmd.TransferSpreadsheet"

J'ai tenté d'utiliser "copyfromrecordset" mais je n'arrive pas a trouver que saisir devant...

Par avance merci pour votre aide !
Bien à vous,
Pierre

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
Private Sub famille_HA_DblClick(Cancel As Integer)
 
Dim ID_ligne
Dim strSQL As String
Dim rst As DAO.Recordset
 
'On Error GoTo FIN:
 
ID_ligne = Me.ID_HA
 
'on donne a la variable strSql la valeur SQL d'une requete renvoyant les valeurs que l'on souhaite copier
strSQL = "SELECT T_FAM_HA.code_fam_ha, T_DDE_HA.ref_fournisseur, T_DDE_HA.design_produit, T_DDE_HA.qté, T_DDE_HA.Longueur, T_DDE_HA.Largeur, T_DDE_HA.Epaisseur, T_DDE_HA.uté " & _
            "FROM T_FAM_HA INNER JOIN T_DDE_HA " & _
            "ON T_FAM_HA.N° = T_DDE_HA.famille_HA " & _
            "WHERE (((T_DDE_HA.ID_HA)=" & ID_ligne & "));"
 
Set rst = CurrentDb.OpenRecordset(strSQL)
 
If rst.RecordCount > 0 Then 'Si la requete renvoie plus d'un enregistrement (donc si le dossier existe)
 
       MsgBox ("réussi1")
 
       clipboard.CopyFromRecordset rst
 
       MsgBox ("réussi2")
Else
    MsgBox ("Ce N° de dossier n'est pas valide")
End If
FIN:
End Sub

[fevec]

Bonjour,
Pour contourner le problème (car je n'ai pas la réponse précise à la question)
2 pistes
1) exporter la requête dans un fichier texte que j'ouvrirais avec le bloc note par un shell.
(je fais cela dans mes applications)
(cela t'oblige à transformer ton recordset en requête et a créer un format d'exportation pour gérer un séparateur de type tabulation)

Code :

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

1
2
3
4
5
6
 Dim R As Long
 Dim F As String
 F = Repertoire & "fichier.txt"
 DoCmd.TransferText acExportFixed, "format d'exportation tabulation", "NomRequete", F, False
 DoEvents
 R = Shell("notepad.exe " & Repertoire & "fichier.txt")

2)
ou alors créer un fichier texte avec FSO..
et coller les champs de ton recordset.. (rst.fields(0) à 7 séparés par une tabulation chr(9)
puis ouvir le fichier avec un shell

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Dim FS As FileSystemObject
Dim F As TextStream
Set FS = CreateObject("Scripting.FileSystemObject")
Set F = FS.OpenTextFile(Repertoire & "fichier.txt", 2, True)
F.Write rst.fields(0) & chr(9) & rst.fields(1)  ...etc jusqu'à 7 
F.WriteLine
F.Close
Set FS = Nothing
Set F = Nothing
 
 DoEvents
 R = Shell("notepad.exe " & Repertoire & "fichier.txt")

(je ne sais plus s'il faut ajouter une référence pour utiliser FSO, mais tu devrais voir ça à la compilation, )


l'utilisateur devra donc faire un copier coller entre ce blocnote/clipboard maison et sa feuille de calcul Excel...


bonne journée

[madefemere]

Bonjour Pierrequimousse,

Je n'ai pas très bien compris ce que tu veux dire par :

Comme je ne souhaite pas lier mon tableur excel je ne peux pas utiliser "DoCmd.TransferSpreadsheet"

Pour moi, la succession d'évènement sera :
1- Tu as formé ta requête.
2- La personne "choisi" le fichier Excel où envoyé les données.
3- Tu rajoutes les enregistrements en VBA : Soit piloter Excel, soit une requête ajout.
4- OPTION : Tu ouvres le fichier Excel.

Cordialement.

[pierrequimousse]

Bonjour Fervec et Madefemere,

Merci pour vos réponses. En fait le fichier excel cible est un gros fichier, et les données doivent être collés à un endroit précis, qui correspond à la dernière ligne d'un onglet. Comme ce fichier n'est pas une base de données très propre, j'ai pensé au presse papier pour que l'utilisateur n'aie qu'à faire clic droit + coller au bon endroit. Cela évite le risque d'erreur d'un code qui chercherait la dernière ligne sur un tableau où il peut y avoir des cellules vides, des filtres, etc...

Quand je fais ce copier/coller manuellement depuis mon formulaire ACCESS il me colle les noms des champs et les données sélectionnées, soit 2 lignes alors que je ne voudrais que les données.

Je continue à chercher, merci en tout cas de vous être penchés sur la problématique !!

Pierre

[Invité]

Bonjour,
Je ne sais pas si c'est la solution, mais disons juste une idée!

http://www.developpez.net/forums/d15...r/#post8435855

Avec adodb.recodset tu as une méthode RcdSet.gettexte tu affect une à un variable la valeur et tu l'envoi au presse papier via les api.

Code :

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

insert into [MyFeuille$] in 'c:\MyFichier.xls' 'Deiver[;' (Select * from MyTableAccess)

Si non tu fais un requête d'ajout dans ton Excel a partir d'Access avec comme source une requête Access!

[pierrequimousse]

Bonjour rdurupt,

Merci pour ta réponse. Au vu des premières réponses je me rend compte que ce n'est pas aussi simple qu'un copier coller !!! Je tente donc de passer par un autre classeur excel avec le fonction transferspreadsheet. J'arrive à faire à peu près ce que je veux mais j'ai une erreur qui arrive à mon troisième lancement de code, et je n'arrive pas à l'expliquer...

Je lance une première fois, le test si le fichier excel est ouvert fonctionne, comme le fichier n'est pas ouvert il l'ouvre et le transfert fonctionne... OUF

Je lance une seconde fois, le test fonctionne et détecte que mon fichier est ouvert, le ferme puis le réouvre comme ci dessus et le transfer fonctionne... RE OUF (j'ai procédé comme cela car je n'arrivais pas à accéder au fichier ouvert, et y affecter la variable xlapp)

Je lance une troisième fois et là... Erreur 9 sur la ligne de commande qui doit fermer le fichier !!!

Je ne suis pas très à l'aise avec le pilotage d'Excel via Access, il doit y avoir un truc je sens que je ne suis pas loin... Par avance merci pour vos lumières sur ce point !

Bien cordialement
Pierre

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
Private Sub famille_HA_DblClick(Cancel As Integer)
 
Dim ID_ligne
Dim strSQL As String
Dim rst As DAO.Recordset
Dim n As Long
 
 
'On Error GoTo FIN:
 
ID_ligne = Me.ID_HA
 
'on donne a la variable strSql la valeur SQL d'une requete renvoyant les valeurs que l'on souhaite copier
strSQL = "SELECT T_FAM_HA.code_fam_ha, T_DDE_HA.ref_produit, T_DDE_HA.qté, T_DDE_HA.design_produit, T_DDE_HA.Longueur, T_DDE_HA.Largeur, T_DDE_HA.Epaisseur, T_DDE_HA.uté " & _
            "FROM T_FAM_HA INNER JOIN T_DDE_HA " & _
            "ON T_FAM_HA.N° = T_DDE_HA.famille_HA " & _
            "WHERE (((T_DDE_HA.ID_HA)=" & ID_ligne & "));"
 
Set rst = CurrentDb.OpenRecordset(strSQL)
 
If rst.RecordCount > 0 Then 'Si la requete renvoie plus d'un enregistrement (donc si le dossier existe)
 
 
 
Dim XLApp As Excel.Application
Dim XLWorkbook As Excel.Workbook
 
 
    If IsFileOpen("C:\Users\p\Desktop\TEST.xlsx") Then
      MsgBox ("réussi1")
        'Excel.Application.Visible = True
        Excel.Workbooks("TEST.xlsx").Close True
        DoEvents
 
    End If
 
        Set XLApp = CreateObject("Excel.Application")
        XLApp.Visible = True
        Set XLWorkbook = XLApp.Workbooks.Open("C:\Users\p\Desktop\TEST.xlsx")
        DoEvents
        XLApp.Sheets("Feuil1").Select
 
 
 
 
n = XLApp.Range("A" & XLApp.Rows.Count).End(xlUp).Row
 
    MsgBox (n)
 
'Exportation du recordset, ENFIN
XLApp.Cells(n + 1, 1).CopyFromRecordset rst
'XLApp.Sheets("Feuil1").Select
       'C:\Users\p\Desktop\TEST.xlsx
       'clipboard.CopyFromRecordset rst
 
       MsgBox ("réussi2")
 
 
Set XLApp = Nothing
Set XLWorkbook = Nothing
 
Else
    MsgBox ("Ce N° de dossier n'est pas valide")
End If
FIN:
End Sub

[Invité]

Pourquoi ne pas faire le travail directement sans passer par le presse papier?

Code :

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

1
2
3
 
DerLingne=sheets("MyOnglet").cells(Cells.Rows.Cout,"A").end(XlUp).row + 1
Cells(DerLingne,1). Copyrecordset rs

[pierrequimousse]

Bonjour Rdurupt,

C'est finalement ce que je suis en train d'essayer, mais comme expliqué dans mon précédent post il doit me manque une syntaxe propre ce qui fait que j'ai l'erreur 9 au troisième lancement de mon code. J'essaie pas mal de chose mais mon niveau sur le pilotage d'excel n'est pas suffisant... J'arrive toujours à un moment à une erreur 9 : l'indice n'appartient pas à la sélection. Ce qui m'étonne c'est que la ligne qui plante fonctionne bien la première fois qu'elle est sollicitée (soit dans mon exemple au second lancement de mon code.

J'ai peut être une erreur sur ma fonction de test si fichier ouvert, que j'ai récupérée sur les forums : je l'ai testé sur un autre poste où le fichier n'existe pas et le code me renvoie ma msgbox qui indique le succès du "if"... Je commence à perdre espoir !

Merci en tout cas pour toutes les réponses.

Pierre

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Function IsFileOpen(ByVal strFic As String) As Boolean
    Dim fic As Integer
    On Error Resume Next
 
    fic = FreeFile()
    Open strFic For Input Access Read Lock Read Write As fic
 
    If Err.Number = 0 Then
        IsFileOpen = False
        Close fic
    Else
        IsFileOpen = True
    End If
    End Function

Cordialement,
Pierre

[Invité]

Bonjour pierrequimousse,

Code :

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

1
2
3
4
5
6
7
8
Set rst = CurrentDb.OpenRecordSet(strSQL)
Set XLApp = CreateObject("Excel.Application")
XLApp.Visible = True
 Set xlWorkbook = XLApp.Workbooks.Open("C:\Users\p.dejonckheere\Desktop\TEST.xlsx")
 DoEvents
With xlWorkbook.Sheets("Feuil1")
   .Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row + 1).CopyFromRecordset rst
End With

[pierrequimousse]

Bonjour rdurupt,

Merci pour cette réponse rapide. Effectivement la fonction marche bien lors de la première utilisation du code. Le souci que je rencontre c'est qu'une fois cette étape passée on a ouvert le classeur excel, et je souhaiterais que lorsque je relance mon code il retourne dans ce même classeur (déjà ouvert) ajouter la ligne suivante. Avec ce code excel me rouvre le fichier excel en lecture seule.

C'est pourquoi j'avais tenté de passer par un test pour voir si le classeur est ouvert.

Après au niveau utilisateur je peux demander que le classeur soit déjà ouver avant de lancer la copie, auquel cas il faudrait adapter le code pour récupérer le bon classeur déjà ouvert et nommé "test". J'ai essayé avec getobject, sans grand succès... J'ai tenté aussi avec workbooks.activate, mais je n'arrive pas à trouver la bonne formulation.

Merci pour votre aide en tout cas !

Pierre

[Invité]

Code :

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

Sql = "insert into * from [NomOnglet$] in 'c:\Fichier.xlsx'  'excel 8.0;HDR=yes;IMEX=1;' (ta requête)"

Là fichier ouvert ou pas tu t'en fiche!

[pierrequimousse]

Bonjour rdurupt,

Je teste cette solution via requête ajout mais je tombe systématiquement sur une erreur "l'opération doit utiliser une requête qui peut être mise à jour". Je reste toutefois convaincu qu'une adaptation du code qui fonctionne avec "copyfromrecordset" pour que cela fonctionne avec le fichier ouvert est à portée ! En cherchant un peu j'ai l'impréssion que le problème réside dans la gestion des instances d'excel, mais j'avoue que ça me dépasse un peu...

[Invité]

Bonjour,
Si tu utilises la méthode getobject tu ouvrira la cession Excel ouverte. Bien sur si tu n'as pas de sessions ouverte tu aurais um message d'erreur qu'il faudra gérer.

Si tu trouve une session tu scan workbooks.Count et tu regardes si ton fichier est dedans.

Si tu as une erreur ton fichier n'est pas ouvert donc tu fais un creatonject.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
on error resume Next
Set xls=GetObject(,"Excel.Application")
If err=0 then
For i =1 to xls.worbooks.count
If xls.worbooks(i).fullname =Fichier then trouve=True:set wb=xls.worbooks(i): exit for
Next
Else
Set xls=CreatObject("Excel.Application")
End if
If trouve =false then Set wb=xls.wokbooks.open(Fichier)
 
On error toto 0