Simplification code

Résolu/Fermé

Villette54 Messages postés 300 Date d'inscription vendredi 15 mars 2013 Statut Membre Dernière intervention 31 juillet 2018 - Modifié le 26 oct. 2017 à 14:29
Villette54 Messages postés 300 Date d'inscription vendredi 15 mars 2013 Statut Membre Dernière intervention 31 juillet 2018 - 26 oct. 2017 à 16:44

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

A voir également:

Simplification code
Code asci - Guide
Code puk bloqué - Guide
Code telephone oublié - Guide
Code blocks free - Télécharger - Langages
Code windows 10 - Guide

2 réponses

Réponse 1 / 2

Villette54 Messages postés 300 Date d'inscription vendredi 15 mars 2013 Statut Membre Dernière intervention 31 juillet 2018 28
Modifié le 26 oct. 2017 à 15:13

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

Réponse 2 / 2

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
26 oct. 2017 à 15:49

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

Villette54 Messages postés 300 Date d'inscription vendredi 15 mars 2013 Statut Membre Dernière intervention 31 juillet 2018 28
26 oct. 2017 à 15:57

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)

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701 > Villette54 Messages postés 300 Date d'inscription vendredi 15 mars 2013 Statut Membre Dernière intervention 31 juillet 2018
26 oct. 2017 à 16:28

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

Villette54 Messages postés 300 Date d'inscription vendredi 15 mars 2013 Statut Membre Dernière intervention 31 juillet 2018 28
26 oct. 2017 à 16:44

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 !

Discussions similaires

Code de renvoi d'appel : Ooredo, Mobilis...

Acces à snapchat temporairement désactivé

Code Free Wifi Secure : comment en récupérer

Erreur 80072EFE windows update

Discussions similaires

Newsletters