Adresse de la cellule active?

Résolu/Fermé

Ribanjo Messages postés 8 Date d'inscription mercredi 19 février 2014 Statut Membre Dernière intervention 22 février 2014 - 19 févr. 2014 à 21:31
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 - 20 févr. 2014 à 18:12

Bonjour, je suis à mes début avec VBA pour excel. Voici ce que je veux faire: dès qu'il y a une modification d'une valeur dans le range(a15:p200) je veux inscrire sur la ligne où il y a eu modification dans la cellule Q(no de ligne) la date d'aujourd'hui. Dans la colonne R les cellules contiennent =aujourdhui(). et finalement dans la colonne S se trouve les formules suivantes = R(no de ligne)-Q(no de ligne). Le but ultime étant de faire une mise en forme conditionnelle sur les valeurs de la ligne a..p. l'idée étant de mettre en surbrillance jaune pendant 5 jours toutes les modifications faites.
Ça fait deux jours que je cherche et que j'essaie toutes sorte de solution et j'aurais besoin d'aide. Voici où j'en suis rendu:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range

Application.EnableEvents = False

If Not Intersect(Target, Range("a15:p200")) Is Nothing Then
For Each Cel In Target
If Not Intersect(Cel, Range("a15:p15")) Is Nothing Then
' sauvegarder la position de la cellule modifiée
Range("a1").Value = ActiveCell.Address
Range("r15").Select
ActiveCell.FormulaR1C1 = "=today()"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
' remettre la sélection sur la cellule modifiée.
ActiveCell.Address = Range("a1").Value

End If

Application.EnableEvents = True

End Sub

A voir également:

Vba adresse cellule active
Nom de l'adresse ✓ - Forum Réseaux sociaux
Darkino nouvelle adresse - Guide
Rechercher ou entrer l'adresse - Guide
Facebook piraté et adresse email changé - Forum Facebook
Adresse mac - Guide

2 réponses

Réponse 1 / 2

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 776
20 févr. 2014 à 09:11

Bonjour,

Pour répondre aux questions précises de ton problème :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range

Application.EnableEvents = False
If Not Intersect(Target, Range("a15:p200")) Is Nothing Then
  For Each Cel In Target.Cells
    If Not Intersect(Cel, Range("a15:p200")) Is Nothing Then
      'colonne Q : n° de ligne
      Cells(Cel.Row, "Q").Formula = Cel.Row
      'colonne R, formule : =AUJOURDHUI()
      Cells(Cel.Row, "R").FormulaLocal = "=AUJOURDHUI()"
      'colonne S, formule : = R(no de ligne)-Q(no de ligne)
      Cells(Cel.Row, "S").FormulaLocal = "=R" & Cel.Row & " - Q" & Cel.Row
    End If
  Next Cel
End If
Application.EnableEvents = True

End Sub

Mais, pour mettre en surbrillance jaune pendant 5 jours toutes les modifications faites :

Private Sub Worksheet_Activate()
'Effacer les lignes surlignées après 5 jours
'
Const p As Integer = 5  'période = 5 jour
Dim Cel As Range

Application.EnableEvents = False
For Each Cel In Range("Q15:Q200").Cells
  If Now - Cells(Cel.Row, "Q").Value >= p Then
    'Effacer la couleur
    Range(Cells(Cel.Row, "A"), Cells(Cel.Row, "P")).Interior.ColorIndex = xlColorIndexNone
  End If
Next Cel
Application.EnableEvents = True

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'Surligner les lignes modifiées
Dim Cel As Range

Application.EnableEvents = False
If Not Intersect(Target, Range("a15:p200")) Is Nothing Then
  For Each Cel In Target.Cells
    If Not Intersect(Cel, Range("a15:p200")) Is Nothing Then
      'colonne Q : instant de la modification
      Cells(Cel.Row, "Q").Formula = Now
      'ligne surlignée e vert
      Range(Cells(Cel.Row, "A"), Cells(Cel.Row, "P")).Interior.ColorIndex = 6
    End If
  Next Cel
End If
Columns("Q").AutoFit
Application.EnableEvents = True

End Sub

Réponse 2 / 2

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 776
20 févr. 2014 à 09:34

J'ai été un peu trop vite, au lieu d'utiliser l'évènement Worksheet_Activate (dont on est pas sur qu'il se produise), il est préférable d'utiliser l'évènement Workbook_Open (qui se produit à chaque ouverture du classeur) :

Private Sub Workbook_Open()
'Effacer les lignes surlignées après 5 jours
'
Const p As Integer = 5  'période = 5 jour
Dim wsh As Worksheet
Dim Cel As Range

Application.EnableEvents = False
'Préciser le nom de la feuille concernée
Set wsh = Worksheets("Feuil1")
With wsh
  For Each Cel In .Range("Q15:Q200").Cells
    If Now - .Cells(Cel.Row, "Q").Value >= p Then
      'Effacer la couleur
      .Range("A" & Cel.Row & ":P" & Cel.Row).Interior.ColorIndex = xlColorIndexNone
    End If
  Next Cel
End With
Application.EnableEvents = True

End Sub

Ribanjo Messages postés 8 Date d'inscription mercredi 19 février 2014 Statut Membre Dernière intervention 22 février 2014
20 févr. 2014 à 16:57

Merci beaucoup pour votre aide. Ça fonctionne comme je le voulais.

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 776
Modifié par Patrice33740 le 20/02/2014 à 18:12

De rien, au plaisir de te relire sur le Forum

Cordialement
Patrice

Discussions similaires

Faire apparaître l'adresse d'une cellule

Trouver coordonnées d'une cellule selon sa valeur

Exploiter adresse cellule présente dans variable

VBA Récupérer coordonnées d'une cellule

Excel : Coordonnées d'une cellule

Excel- Récupérer adresse Cellule en VBA

Discussions similaires

Newsletters