Simplification code

Résolu
Villette54 Messages postés 300 Date d'inscription   Statut Membre Dernière intervention   -  
Villette54 Messages postés 300 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

J'utilise un petit code qui me permet d'écrire automatiquement la date dans une cellule spécifique lorsque l'on clique sur celle-ci.
Le souci c'est que j'ai plus d'une vingtaine de cellule "date" pour lesquelles mon code s'applique, je répète donc celui-ci vingt fois. C'est efficace, mais ce n'est pas très esthétique ni pratique dans mon VBA... Je cherche donc à simplifier mon code si possible.

Merci d'avance pour votre aide :)

Voici un extrait du code en question :
Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub

If Not Intersect(Target, Range("F8")) Is Nothing Then
If Range("F8") <> "" Then
If MsgBox("Voulez-vous changer la date ?", vbQuestion + vbYesNo, "Confirmation") = vbYes Then
Range("F8").Value = Date
Else: Exit Sub
End If
Else: Range("F8").Value = Date
End If
End If

'___________________

If Not Intersect(Target, Range("F25")) Is Nothing Then
If Range("F25") <> "" Then
If MsgBox("Voulez-vous changer la date ?", vbQuestion + vbYesNo, "Confirmation") = vbYes Then
Range("F25").Value = Date
Else: Exit Sub
End If
Else: Range("F25").Value = Date
End If
End If

'___________________

If Not Intersect(Target, Range("F42")) Is Nothing Then
If Range("F42") <> "" Then
If MsgBox("Voulez-vous changer la date ?", vbQuestion + vbYesNo, "Confirmation") = vbYes Then
Range("F42").Value = Date
Else: Exit Sub
End If
Else: Range("F42").Value = Date
End If
End If

'___________________

End Sub

2 réponses

  1. Villette54 Messages postés 300 Date d'inscription   Statut Membre Dernière intervention   28
     
    Re,

    J'ai essayé de "bricoler" quelque chose, mais évidemment ça ne fonctionne pas (surement car je ne connais pas la syntaxe ni la façon d'utiliser .Adress).
    En revanche cela peut être une piste pour résoudre mon problème...

    Voici mon idée :
            If Not Intersect(Target, Range("F8,F25,F42")) Is Nothing Then
    ActiveCell.Address = ref
    If Range(ref) <> "" Then
    If MsgBox("Voulez-vous changer la date ?", vbQuestion + vbYesNo, "Confirmation") = vbYes Then
    Range(ref).Value = Date
    Else: Exit Sub
    End If
    Else: Range(ref).Value = Date
    End If
    End If
    0
  2. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour,

    Sub Worksheet_SelectionChange(ByVal Target As Range)
        If Target.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("F8,F25,F42")) Is Nothing Then
            ref = Target.Address
            If Range(ref) <> "" Then
                If MsgBox("Voulez-vous changer la date ?", vbQuestion + vbYesNo, "Confirmation") = vbYes Then
                    Range(ref).Value = Date
                Else: Exit Sub
                End If
            Else: Range(ref).Value = Date
            End If
        End If
    End Sub
    
    0
    1. Villette54 Messages postés 300 Date d'inscription   Statut Membre Dernière intervention   28
       
      Bonjour,

      Merci pour la réponse qui fonctionne très bien.

      Pour information, je venais de réussir à bricoler un petit quelque chose aussi qui avait l'air de fonctionner :
      Sub Worksheet_SelectionChange(ByVal Target As Range)
      Dim Ref As Range

      If Target.Count > 1 Then Exit Sub
      If Not Intersect(Target, Range("F8,F25")) Is Nothing Then
      Set Ref = Selection
      If Ref <> "" Then
      If MsgBox("Voulez-vous changer la date ?", vbQuestion + vbYesNo, "Confirmation") = vbYes Then
      Ref.Value = Date
      Else: Exit Sub
      End If
      Else: Ref.Value = Date
      End If
      End If


      Par simple curiosité, comment met-on le code en forme + couleurs sur le forum ?

      Encore merci et bonne journée.

      (Je vais clôturer le sujet dans quelques minutes, j'attends juste une éventuelle réponse à ma question ou une remarque sur mon code)
      0
      1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717 > Villette54 Messages postés 300 Date d'inscription   Statut Membre Dernière intervention  
         
        Re,

        code le plus simple et "logique"

        Sub Worksheet_SelectionChange(ByVal Target As Range)
            If Target.Count > 1 Then Exit Sub
            If Not Intersect(Target, Range("F8,F25,F42")) Is Nothing Then
                If Target <> "" Then
                    If MsgBox("Voulez-vous changer la date ?", vbQuestion + vbYesNo, "Confirmation") = vbYes Then
                        Target.Value = Date
                    Else: Exit Sub
                    End If
                Else: Target.Value = Date
                End If
            End If
        End Sub


        comment met-on le code en forme + couleurs sur le forum ?
        En haut a droite vous avez B I S <> et V: selectionner le texte que vous voulez mettre en forme, clic sur la fleche vers le bas et choisisez le langage
        0
    2. Villette54 Messages postés 300 Date d'inscription   Statut Membre Dernière intervention   28
       
      Re,

      Je n'avais pas fais attention à la petite flèche...Merci

      Effectivement ce code me semble plus logique, je vais opter pour celui-ci !

      Encore merci pour l'aide !
      0