Discussion :

[vodiem]

Bonjour,

En affichage Feuille de donnée il est parfois pratique de pouvoir recopier une valeur dans plusieurs enregistrement (à la façon d'excel: copier puis coller dans plusieurs cellules présélectionnées) or dans notre cas seul le control actif est recopié malgré la zone de sélection.

voici donc un p'tit code qui permettra de simuler ce traitement:

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
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Set frm = Me.Form
 
If (((Shift And acCtrlMask) > 0) And KeyCode = 86) Or ((KeyCode = 46) And ((frm.SelHeight + frm.SelWidth) <> 0)) Then ' CTRL+V OR (SUPPR et pas en édition)
 
    If frm.CurrentView = 2 Then
        Application.Echo False
 
 
        'Save
        lngNumRows = frm.SelHeight
        lngNumColumns = frm.SelWidth
        lngTopRow = frm.SelTop
        lngLeftColumn = frm.SelLeft
 
        frm.SelWidth = 1
        frm.SelHeight = 1
 
        'Coller
        On Error Resume Next    'pour les types <>
        nj = lngNumRows - IIf(lngNumRows > 0, 1, 0)
        ni = lngNumColumns - IIf(lngNumColumns > 0, 1, 0)
        contenu = IIf((KeyCode = 46), "", ClipBoard_GetData())
 
        For j = 0 To nj
            frm.SelTop = lngTopRow + j
            For i = 0 To ni
                frm.SelLeft = lngLeftColumn + i
                ActiveControl = contenu
            Next i
        Next j
 
        'Restore
        frm.SelHeight = lngNumRows
        frm.SelWidth = lngNumColumns
        frm.SelTop = lngTopRow
        frm.SelLeft = lngLeftColumn + ((lngNumRows + lngNumColumns) = 0)
 
        If KeyCode <> 46 Then KeyCode = 0
        Application.Echo True
    End If
End If
 
If ((Shift And acCtrlMask) > 0) Then
    Select Case KeyCode
        Case vbKeyLeft:     'CTRL + Gauche
            If SelWidth >= 1 Then
                Echo False
                min = SelLeft: prochain = SelLeft
                Do
                    prochain = prochain - 1
                    SelLeft = prochain
                    If prochain = SelLeft Then c = (Nz(ActiveControl, "") = ""): min = SelLeft
                Loop Until (c) Or (prochain <= 1)
                If Not c Then SelLeft = min
                Echo True
                KeyCode = 0
            End If
        Case vbKeyRight:    'CTRL + Droit
            If SelWidth >= 1 Then
                Echo False
                p = SelLeft
                DoCmd.RunCommand acCmdSelectRecord: nb = SelWidth: SelWidth = 0: SelWidth = 1
                SelLeft = p
                If SelLeft <> nb Then
                    Do
                        prochain = SelLeft + 1
                        SelLeft = prochain
                        If prochain = SelLeft Then c = (Nz(ActiveControl, "") = ""): max = SelLeft
                    Loop Until (c) Or (prochain >= nb)
                    If Not c Then SelLeft = max
                End If
                Echo True
                KeyCode = 0
            End If
        Case vbKeyUp:       'CTRL + Haut
            Form.Recordset.FindPrevious "Nz([" & ActiveControl.Name & "],'')=''"
        Case vbKeyDown:     'CTRL + Bas
            Form.Recordset.FindNext "Nz([" & ActiveControl.Name & "],'')=''"
    End Select
End If
 
End Sub

à mettre dans l'événement "Sur touche appuyée" du formulaire et activant "Aperçu des touches" à "Oui".

l'instruction:
DoCmd.RunCommand acCmdPaste
ne fonctionnant pas correctement je l'ai substitué par l'emploie de ClipBoard_GetData()
que l'on peut trouver ici.
dont voici la copie à mettre dans un module:

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
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 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

j'ai complété avec la gestion de la suppression de la zone de sélection.

emploi: dans un formulaire en affichage "Feuille de donnée":
. sélectionner un champ
. copier avec par exemple CTRL+C
. définissez une zone de sélection
. coller avec CTRL+V (ou supprimer avec les touches de suppression)

des améliorations pourront être apporter sur:
. la "suppression" <=> champ="" qui pourrait tout autant être: champ=null ou mieux: adaptable en fonction du type de champ et de ses contraintes...
. un message de confirmation si la zone de sélection est sur plusieurs enregistrements: plus d'annulation possible.
. analyser le contenu du presse-papier pour pouvoir dupliquer plusieurs champs
. gérer le collage par souris
...

enfin... cela n'a pas la prétention de remplacer l'emploi d'un tableur mais simplement de donner un peu plus de souplesse à l'édition.

edit du 09/11/09: ajout du déplacement CTRL+haut, CTRL+bas.
edit du 16/11/09: ajout du déplacement CTRL+gauche, CTRL+droit

[vodiem]

le code a été maj:
.ajout du déplacement CTRL+haut et CTRL+bas vers le prochain champ vide.
.modification de la gestion de la suppression pour pouvoir supprimer aussi l'enregistrement.

[vodiem]

mise à jour du code pour les déplacements CTRL+gauche, CTRL+droit.

[curt]

Bonjour Vodiem,

et merci pour cet outil.

ça fait bien longtemps qu'on me demandait de pouvoir faire "comme sur Excel"....

Tu vas faire des heureux.

Curt