Discussion :

[fred63]

Bonjour à tous

Je dois automatiser le transfert de données excel vers access mais sans passer par les fonctions classiques ( TransferSpreadsheet ). En fait je dois être capable de transférer directement des données d'une feuille excel dans les champs d'une table access à l'aide d'un copier/coller du presse papier.
J'ai récupérer une API me permettant d'accéder au presse papier ( clipboard ) directement depuis access. Je dois maintenant développer un algo de conversion des donnes access ( avec des caractères ascii ) dans access.
Je voulais savoir si quelqu'un d'entre vous n'avez pas déjà réalisé un tel algo car je dois dire que mes compétences en VBA ne sont pas encore suffisante.

Merci de votre aide

Fred

[Papy Turbo]

Je vais peut êre dire une bêtise qui ne correspond pas à ce que tu veux faire, mais qu'est-ce que ça donne avec

Code :

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

docmd.RunCommand acCmdPaste

:

[fred63]

Merci de ta réponse mais j'ai réussi à programmer mon algorithme .
Pour ceux que ça intéresse, je vais le mettre dans ce post.

Ce code permet d'importer des valeurs d'une table excel directement dans les champs désirés d'une table access à l'aide d'un copier-coller de la zone à importer. L'import s'effectue même si la zone de copie ne contient pas autant de champ que la zone de collage et même sil elle contient des blancs ( sauf bug voir fin du post ).


Pour commencer il faut installer le module permettant d'avoir accès au presse-papier

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
98
99
100
101
102
103
104
105
106
107
108
 
Option Compare Database
Option Explicit
 
    Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
    Declare Function CloseClipboard Lib "user32" () As Long
    Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
    Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
    Declare Function EmptyClipboard Lib "user32" () As Long
    Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal dwBytes As Long) As Long
    Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
    Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
    Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
    Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
 
   Public Const GHND = &H42
   Public Const CF_TEXT = 1
   Public Const MAXSIZE = 4096
Function ClipBoard_GetData()
 
    Dim hClipMemory As Long
    Dim lpClipMemory As Long
    Dim MyString As String
    Dim retval As Long
 
    If OpenClipboard(0&) = 0 Then
       MsgBox "Cannot open Clipboard. Another app. may have it open"
       Exit Function
    End If
 
    ' Obtain the handle to the global memory
    ' block that is referencing the text.
    hClipMemory = GetClipboardData(CF_TEXT)
    If IsNull(hClipMemory) Then
       MsgBox "Could not allocate memory"
       GoTo OutOfHere
    End If
 
    ' Lock Clipboard memory so we can reference
    ' the actual data string.
    lpClipMemory = GlobalLock(hClipMemory)
 
    If Not IsNull(lpClipMemory) Then
       MyString = Space$(MAXSIZE)
       retval = lstrcpy(MyString, lpClipMemory)
       retval = GlobalUnlock(hClipMemory)
       ' Peel off the null terminating character.
       MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
    Else
       MsgBox "Could not lock memory to copy string from."
    End If
 
OutOfHere:
 
    retval = CloseClipboard()
    ClipBoard_GetData = MyString
 
End Function
Function ClipBoard_SetData(MyString As String)
 
    Dim hGlobalMemory As Long, lpGlobalMemory As Long
    Dim hClipMemory As Long, X As Long
 
    ' Allocate moveable global memory.
    '-------------------------------------------
    hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)
 
    ' Lock the block to get a far pointer
    ' to this memory.
    lpGlobalMemory = GlobalLock(hGlobalMemory)
 
    ' Copy the string to this global memory.
    lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
 
    ' Unlock the memory.
 
    If GlobalUnlock(hGlobalMemory) <> 0 Then
       MsgBox "Could not unlock memory location. Copy aborted."
       GoTo OutOfHere2
    End If
 
    ' Open the Clipboard to copy data to.
    If OpenClipboard(0&) = 0 Then
       MsgBox "Could not open the Clipboard. Copy aborted."
       Exit Function
    End If
 
    ' Clear the Clipboard.
    X = EmptyClipboard()
 
    ' Copy the data to the Clipboard.
 
    hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
 
OutOfHere2:
 
    If CloseClipboard() = 0 Then
       MsgBox "Could not close Clipboard."
    End If
 
End Function
 
 
Function ClipBoard_Clear()
Call OpenClipboard(0&)
Call EmptyClipboard
Call CloseClipboard
End Function

Ensuite mettre le code suivant sur le clic d'un bouton

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
 
Private Sub import_Click()
 
Dim NoCarTAB As Long  'caractère de tabulation, donc de changement de champ
Dim NoCarENT As Long  'caractère d'entrée, donc de changement de ligne
Dim NoCarPrec As Long 'caractère précédent
Dim TabChamp(7) As Variant 'Table regroupant mes 7 champs
Dim NoCar As Long 'longeur de la chaine à importer dans un champ
Dim NumChamp As Long 'numéro de champ
Dim NoNolonne As Long 'numéro de colonne
 
Set TabChamp(1) = Me.Code
Set TabChamp(2) = Me.Désignation
Set TabChamp(3) = Me.Limitation_configurable
Set TabChamp(4) = Me.ATO
Set TabChamp(5) = Me.ATF
Set TabChamp(6) = Me.FIL
Set TabChamp(7) = Me.FV
 
ChaineRecherche = ClipBoard_GetData() 'correspond à la zone copiée
 
NoCarPrec = 1   '
NumChamp = 1    ' initialisation des variables
NoColonne = 1   '
 
 
Do While (NoCarPrec <= Len(ChaineRecherche))
 
NoCarTAB = InStr(NoCarPrec, ChaineRecherche, Chr(9))
NoCarENT = InStr(NoCarPrec, ChaineRecherche, Chr(13))
 
    If (NoCarTAB < NoCarENT And Not NoCarTAB = 0 And Not NoCarTAB = NoCarPrec And Not NoCarENT = NoCarPrec) Or NoCarENT = 0 Then
 
        NoCar = NoCarTAB - NoCarPrec
        TabChamp(NumChamp).Value = Mid(ChaineRecherche, NoCarPrec, NoCar)
        NoCarPrec = NoCarTAB + 1
        NumChamp = NumChamp + 1
        NoColonne = NoColonne + 1
 
    End If
 
    If NoCarENT > 0 And NoCarENT < NoCarTAB Then
 
        NoCar = NoCarENT - NoCarPrec
        TabChamp(NumChamp).Value = Mid(ChaineRecherche, NoCarPrec, NoCar)
        DoCmd.GoToRecord , Table_Configurables_sous_formulaire, acNewRec
        NoCarPrec = NoCarENT + 2
        NumChamp = 1
        NoColonne = 1
 
    End If
 
 
    If NoCarTAB = 0 Then
 
        NoCar = Len(ChaineRecherche) - NoCarPrec - 1
        TabChamp(NumChamp).Value = Mid(ChaineRecherche, NoCarPrec, NoCar)
        NoCarPrec = Len(ChaineRecherche) + 1
 
    End If
 
    If NoCarTAB = NoCarPrec Then
 
        TabChamp(NumChamp).Value = Null
        NoCarPrec = NoCarTAB + 1
        NumChamp = NumChamp + 1
        NoColonne = NoColonne + 1
 
    End If
 
    If NoCarENT = NoCarPrec Then
 
        TabChamp(NumChamp).Value = Null
        DoCmd.GoToRecord , Table_Configurables_sous_formulaire, acNewRec
        NoCarPrec = NoCarENT + 2
        NumChamp = 1
        NoColonne = 1
 
    End If
 
    If NoColonne > 7 Then
 
        MsgBox (" Vous avez selectionné une zone de copie de taille trop importante")
        Me.Undo
 
    End If
Loop
 
End Sub

Il reste néanmoins un peu de travail
-gérer les erreurs éventuels ( erreur de format,...)
-il reste un bug lorsque la première colonne à importer contient un blanc. Je vais essayer d'y remedier et je vous tiendrais informer de la solution.

A+

Fred

[Papy Turbo]

Ben, bon courage, hein ? Si ça marche, bravo.
Du coup je n'ose pas te parler d'OLE, je suppose que tu as déjà trouvé tout ce qu'il y a sur le sujet dans les FAQs et articles...
Surtout, j'ai du mal à comprendre ce que doit faire l'utilisateur :
- tu utilises ClipBoard_GetData() mais pas l'autre : ClipBoard_SetData()
- donc, l'utilisateur doit sélectionner une zone de 7 cellules dans Excel, les copier et cliquer sur ton bouton pour les coller dans 7 champs d'une table (ou dans 7 contrôles d'un formulaire) ?

[fred63]

l'utilisateur doit sélectionner une zone de 7 cellules dans Excel, les copier et cliquer sur ton bouton pour les coller dans 7 champs d'une table (ou dans 7 contrôles d'un formulaire)

Ce n'est pas tout à fait exact: l'utilisateur peut choisir de selectionner au maximum une zone de 7 colonnes par n lignes, et donc il n'y a aucune limitation sur le nombre de cellules ( mais l'algo fonctionne aussi avec moins de 7 colonnes ). Ensuite l'algo permet de transférer ces valeurs dans les champs correspondant du formulaire.

Je dois dire que je ne voyais pas forcément l'intérêt d'un tel algo : je pensais passer par un transfert de feuilles excels mais mon tuteur ( je suis en stage ) tenait à utiliser un copier /coller, donc je me suis exécuté .

En revanche tu parles de OLE ? Etait-ce utile à mon problème ? Je ne sais pas grand chose sur ce sujet mais je vais me renseigné.

Au fait bravo pour ta promotion Papy Turbo

Merci et à+

Fred

[Papy Turbo]

OK pour l'exercice, au moins ton prof dépasse un peu le niveau des exercices 'standards' !
Par contre, est-ce que tu as testé avec

Code :

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

docmd.RunCommand acCmdPaste

? Access sait très bien importer du presse papier des tableaux. À ta place, j'aurais
- sélectionné une seule cellule, dans le coin en haut à gauche, là où on doit coller : avec les propiétés SelTop et SelLeft du formulaire.
- appelé Docmd... pour laisser Access traduire les blancs, les colonnes...Mais ça, c'est parce que je suis flemmard
Et ça n'est jamais aussi facile que ça, dans la pratique...
[quote="fred63"]

En revanche tu parles de OLE ? Etait-ce utile à mon problème ? Je ne sais pas grand chose sur ce sujet mais je vais me renseigné.

Ça, c'est la solution évidente pour transférer des données cellule par cellule :
- depuis Access, tu récupères l'accès à la feuille Excel,
- tu repères la sélection dans Excel (1ère cellule en haut à gauche, largeur, hauteur),
- tu parcours chaque cellule d'Excel,
- selon le type, tu copies la valeur dans Access, avec ou sans conversion...
Là, tu peux vraiment faire ce que tu veux (sans aucun API, hélas pour les acharnés )

Bon courage pour la suite.