XL 2016 VBA insérer automatiquement une valeur sous la cellule active

[piga25]

Bonjour,
Après pas mal de recherches, je bloque sur le code suivant.
Dans une feuille, lorsque je tape P ou X j'aimerai que sous cette cellule s'inscrive automatiquement la valeur (format heure) qui est située dans la même colonne mais dans une ligne bien définie.
Il y a uniquement la ligne 9 et celle qui correspond à FinNom +3 qui ont ces données.

lorsque je mets par exemple dans le code

Case "P"
        ActiveCell.Offset(0, 0) = "10:30"

cela fonctionne
mais quand je fait référence à la cellule contenant l'heure située plus haut cela ne fonctionne plus.

Sub Worksheet_Change(ByVal Target As Range)
Dim FinNom As Long
Dim x, y As Date
FinNom = ActiveSheet.Range("A7").End(xlDown).Row
  x = Cells(9, ActiveCell.Column).Value
  y = Cells(FinNom + 3, ActiveCell.Column).Value

If Target.Column < 25 Then Exit Sub 'si avant colonne 25 on sort de la procédure

If Target.Row < FinNom Then ' si saisie avant la ligne située avant finnom
    Select Case Target.Value
    Case ""
        ActiveCell.Offset(1, 0) = ""
    Case "P"
        ActiveCell.Offset(0, 0) = x 'Cells(9, 0).Value
    Case "X"
        ActiveCell.Offset(0, 0) = x 'Cells(9, 0).Value
    Case "A"
        ActiveCell.Offset(0, 0) = ""
    End Select
If Target.Row > FinNom Then ' si saisie avant la ligne située après finnom
    Select Case Target.Value
    Case ""
        ActiveCell.Offset(1, 0) = ""
    Case "P"
        ActiveCell.Offset(0, 0) = y 'Cells(FinNom + 3, 0).Value
    Case "X"
        ActiveCell.Offset(0, 0) = y 'Cells(FinNom + 3, 0).Value
    Case "A"
        ActiveCell.Offset(0, 0) = ""
    End Select
End If
End If
End Sub

 

[Robert]

Bonjour Piga, bonjour le forum,

Pas vraiment compris ton problème mais ActiveCell.Offset (0, 0) ça me semble être la même chose qu'ActiveCell. Pourquoi compliquer ?

 

[piga25]

Bonjour Robert, le forum

j'ai mis ActiveCell.Offset (0, 0) pour que cela m'inscrive dans la même colonne mais sur la ligne en dessous.
Avant j'avais ActiveCell.Offset (1, 0) et cela m'inscrivait deux ligne en dessous.

je mets un fichier exemple pour plus de compréhension

 

[piga25]

Bonjour le forum

Je ne sais pas s'il y a moyen de réduire le code, mais tel qu'il est, il fonctionne.
J'ai ajouter les lignes pour mettre en majuscule pour que cela puisse correspondre avec "Case"
De même j'avais oublié la condition "Else" pour accéder la seconde condition

Sub Worksheet_Change(ByVal Target As Range)
Dim FinNom As Long
Dim x, y As Long
FinNom = ActiveSheet.Range("A7").End(xlDown).Row
  x = Cells(9, ActiveCell.Column).Value
  y = Cells(FinNom + 4, ActiveCell.Column).Value

If Not Application.Intersect(Target, Range("Y8:CB100")) Is Nothing Then 'met en majuscule la saisie
    Application.EnableEvents = False
    Target = UCase(Target)
    Application.EnableEvents = True
End If

If Target.Column < 25 Then Exit Sub 'si avant colonne 25 on sort de la procédure

If Target.Row < FinNom Then ' si saisie avant la ligne située avant finnom
    Select Case Target.Value
    'Case ""
     '   ActiveCell.Offset(0, 0) = ""
    Case "P"
        ActiveCell.Offset(0, 0) = x 'Cells(9, 0).Value
    Case "X"
        ActiveCell.Offset(0, 0) = x 'Cells(9, 0).Value
    Case "A"
        ActiveCell.Offset(0, 0) = ""
    End Select
Else
If Target.Row > FinNom Then ' si saisie avant la ligne située après finnom
    Select Case Target.Value
    'Case ""
     '   ActiveCell.Offset(1, 0) = ""
    Case "P"
        ActiveCell.Offset(0, 0) = y 'Cells(FinNom + 3, 0).Value
    Case "X"
        ActiveCell.Offset(0, 0) = y 'Cells(FinNom + 3, 0).Value
    Case "A"
        ActiveCell.Offset(0, 0) = ""
    End Select
End If
End If
End Sub

 

[Robert]

L'événement Change se déclenche à la validation de la cellule. Soit avec avec la touche [Entée] (la cellule de départ devient la cellule au-dessus de la cellule active) soit avec la touche [Tabulation] (la cellule de départ devient la cellule à gauche de la cellule active), soit encore avec la combinaison [CTRL]+[Entrée] (la cellule de départ reste la cellule active) ou en cliquant avec la souris sur n'importe quelle autre cellule (la cellule de départ devient un mystère). Donc, en fonction de la validation ton code devra s'adapter. Belle usine à gaz en perspective...

 

[piga25]

Re - Robert
En effet je viens de m'en apercevoir.
Existe-il une solution pour obliger à valider par la touche [Entrée] ?

 

[Robert]

Re,

Je ne sais pas, mais tu pourrais aussi stocker la cellule de départ dans une variable du style :

Private CdD As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set CdD = ActiveCell
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox CdD.Address
End Sub

Mais pour être sur d'avoir cette variable initialisée il faudrait bouger au moins une fois avec :

Private Sub Worksheet_Activate()
Range("A1").Select
End Sub

et pour bétonner, je rajouterais :

Private Sub Workbook_Open()
Sheets("Feuil1").Activate 'à adapter avec l'onglet en question
End Sub

Après tu utilise la variable CdD (Cellule de Départ) dans ton code...

 

[piga25]

RE,

devant m'absenter pour la soirée, je regarde cela cette nuit.
Merci

 

[job75]

Bonjour piga25, Robert,

Il y a un truc qui m'étonne : pourquoi utiliser ActiveCell ?

S'agissant d'une Worksheet_Change on utilise classiquement Target(1) l'indice (1) étant nécessaire en cas de sélection multiple.

Et pour la cellule du dessous ce sera Target(2,1)

A+

 

[job75]

Re,

Par ailleurs d'après ce que je vois il ne faudrait traiter que les cellules situées sur des lignes paires.

A+

 

[piga25]

Bonjour, Job75

Oui, c'est uniquement les lignes paires qui doivent recevoir la saisie de : "P" ou "A" ou "X" ou vide (effacement) et les lignes impaires a ce moment la reçoivent la données de la ligne 9 (premier tableau) et de la ligne FinNom + 4 (deuxième tableau).

Dans le fichier final, j'ai la Sub Worksheet_Change(ByVal Target As Range) qui ne se lance plus après que j'ai changé de semaine. Je suis obligé de fermer le fichier puis de l'ouvrir pour que le code fonctionne à nouveau.
Est-ce qu'il y a des limites à ne pas franchir pour les SUB WORKSHEET CHANGE()

Pas bien saisie pour la cellule du dessous : target(2,1) j'aurai plus mis target(1,0) même colonne mais une ligne en plus

 

[job75]

Pas bien saisie pour la cellule du dessous : target(2,1) j'aurai plus mis target(1,0) même colonne mais une ligne en plus

Eh bien il faut persévérer pour comprendre cette syntaxe, c'est très important.

 

[piga25]

Eh bien il faut persévérer pour comprendre cette syntaxe, c'est très important.

Je pense avoir compris la syntaxe
Target est la cible
(2,1) la destination
après c'est comme dans un tableau (ligne, colonne)
(1,1) c'est sur la même cellule, donc en augmentant les valeurs, on déplace la destination.

 

[Robert]

Bonjour le fil, bonjour le forum,

S'agissant d'une Worksheet_Change on utilise classiquement Target(1) l'indice (1) étant nécessaire en cas de sélection multiple.

P..! J'avais même pas vu ça... Quelle honte !

 

[piga25]

Bonjour Robert, Job75, le forum

J'ai vu qu'il y avait aussi un autre avantage d'utiliser target(2,1). Si on valide autrement que par entrée, rien ne se passe, donc plus de soucis sur le positionnement de la touche de départ.
Voir si j'ai vraiment bien compris target:
Target(1) = 5 c'est idem que Target(1,1) = 5 (donne la valeur 5 à la cible)
Target(2,1) = c'est idem que Target.offset(1,0) = 5 (donne la valeur 5 à la cellule située une ligne en dessous et même colonne, cela permet de faire un décalage de l'action a faire par rapport à la cible "Target")