Déplacement automatique de la sélection d’une cellule.

Version imprimable

02/03/2013, 11h52
langa68

Déplacement automatique de la sélection d’une cellule.

Bonjour,

Dans mon tableau Excel comprenant plusieurs feuilles j’aimerais intégrer une macro avec les fonctions suivantes :

La cellule de départ de la Macro devra être choisie par un double clic sur cette cellule. Supposons que ce soit dans la cellule B5.
Après entrée des données et appuis sur la touche Valider, la cellule de droite devra être sélectionnée, donc C5.
Ensuite après entrée des données dans cette cellule et appuis sur la touche Valider, la cellule B6 devra être sélectionnée. Puis après validation ce sera la cellule C6 qui devra être sélectionnée et ainsi de suite.
La valeur des cellules sera numérique, elle pourra aussi être vide.

Après un double clic dans une autre cellule de la feuille ou d’une autre feuille le même processus devra s’engager.

J’espère que mon souhait n’est pas trop impertinent.
Je remercie d’avance toute personne qui pourra m’aider.

André

Bonjour,

Ci dessous un code qui devrait t'aider.
A coller dans thisworkbook

Code:

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
Public Rg As Range
Public r As Integer
Public c As Integer
 
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Set Rg = Target
r = 0
c = 1
End Sub
'
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not Rg Is Nothing Then
 
    If Not Application.Intersect(Target, Range(Rg, Rg.Offset(1, 1))) Is Nothing Then
        Application.EnableEvents = False
        Set Rg = Rg.Offset(r, c)
        Rg.Select
        If r = 0 Then r = 1 Else r = 0
        If r = 0 Then c = 1 Else c = -1
        Application.EnableEvents = True
    Else
        Set Rg = Nothing
    End If
End If
 
End Sub

bonsoir

ceci me paraît pratique:

Code:

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
Dim mvDir As Integer, deM As Integer, init As Boolean
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
    If Target.Address = "$B$5" Then
        If Not init Then
            init = True
            mvDir = Application.MoveAfterReturnDirection
            MsgBox "pour sortir de la zone d'édition, double-cliquez à nouveau sur n'importe quelle autre cellue en dehors de la zone d'édition .", vbInformation, "Zone acivée"
 
        End If
 
        deM = 1
 
        With Application
            .EnableEvents = False
            Range("B5:C6").Select
            .MoveAfterReturnDirection = xlToRight            
            .EnableEvents = True
        End With
 
        Feuil1.ScrollArea = "$B$5:$C$6"
    Else
        '
        Feuil1.ScrollArea = ""
        Application.MoveAfterReturnDirection = mvDir
        deM = 0 'indiquer à d'autres gestionnaires l'action
    End If
 
End Sub