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

piga25

XLDnaute Barbatruc
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
VB:
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.

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

piga25

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

Pièces jointes

  • Classeur piga25.xlsm
    61.4 KB · Affichages: 27

piga25

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

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

XLDnaute Barbatruc
Repose en paix
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...
 

Robert

XLDnaute Barbatruc
Repose en paix
Re,

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

VB:
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 :
VB:
Private Sub Worksheet_Activate()
Range("A1").Select
End Sub

et pour bétonner, je rajouterais :

VB:
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...
 

job75

XLDnaute Barbatruc
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+
 

piga25

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

piga25

XLDnaute Barbatruc
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")
 

Statistiques des forums

Discussions
311 712
Messages
2 081 802
Membres
101 819
dernier inscrit
lukumubarth