XL 2010 VBA - Fonction double clics à opérations multiples

Titi456

XLDnaute Junior
Bonjour,

J'essaie en vainc de pouvoir diversifier ma fonction double clics pour pouvoir dans mes colonnes B et F insérer la date et dans la colonne E insérer du texte.
J'ai ce bout de code mais il ne fonctionne pas:

VB:
Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ActiveSheet.Unprotect Password:="."
    If Not Intersect(Target, Range("B:B , F:F")) Is Nothing Then
        Cancel = True
        If Target = "" Then
        Target.Formula = Date
        Else
        Target = ""
   
   
    If Not Intersect(Target, Range("E:E")) Is Nothing Then
        Cancel = True
        If Target = "" Then
        Target = "TEXT"
        Else
        Target = ""
        End If
    End If
        ActiveSheet.Protect Password:="."
End Sub

Pouvez-vous m'aider?

Mes meilleures salutations,

Thierry
 
Solution
Bonjour,
VB:
Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ActiveSheet.Unprotect Password:="."
    If Not Intersect(Target, Range("B:B , F:F")) Is Nothing Then
        Cancel = True
        If Target = "" Then
            Target.Formula = Date
        Else
            Target = ""
        End If
    End If
    If Not Intersect(Target, Range("E:E")) Is Nothing Then
        Cancel = True
        If Target = "" Then
            Target = "TEXT"
        Else
            Target = ""
        End If
    End If
        ActiveSheet.Protect Password:="."
End Sub

Oneida

XLDnaute Impliqué
Bonjour,
VB:
Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ActiveSheet.Unprotect Password:="."
    If Not Intersect(Target, Range("B:B , F:F")) Is Nothing Then
        Cancel = True
        If Target = "" Then
            Target.Formula = Date
        Else
            Target = ""
        End If
    End If
    If Not Intersect(Target, Range("E:E")) Is Nothing Then
        Cancel = True
        If Target = "" Then
            Target = "TEXT"
        Else
            Target = ""
        End If
    End If
        ActiveSheet.Protect Password:="."
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 209
Messages
2 086 273
Membres
103 168
dernier inscrit
isidore33