XL 2010 Comptez le nombre total de clics dans une cellule spécifiée dans Excel

[Learning process]

Bonjour je souhaite compter le nombre total de clics dans une cellule spécifiée dans Excel.
J'ai utilisé le code suivant pour commencer :

Public xRgS, xRgD As Range
Public xNum As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRgS = Range("E2")
If xRgS Is Nothing Then Exit Sub
Set xRgD = Range("H2")
If xRgD Is Nothing Then Exit Sub
If Intersect(xRgS, Target) Is Nothing Then Exit Sub
xNum = xNum + 1
xRgD.Value = xNum
End Sub

Il marche pour la plupart des cas néanmoins, je travaille sur une feuille protégée donc le code vba ne peut pas écrire sur cette feuille.
Est-il possible autoriser le code à écrire sur ma feuille protégée, ou changer les options de protection de ma feuille.
Si cela n'est pas possible écrire le résultat sur une autre feuille, elle, non protégé serait bien aussi.

Merci d'avance pour votre aide.

 

[mapomme]

Bonjour,

Est-il possible autoriser le code à écrire sur ma feuille protégée, ou changer les options de protection de ma feuille.

Activez la protection de la feuille par code avec le paramètre UseInterfaceOnly à True.
Voyez ici le paramètre : UserInterfaceOnly

UserInterfaceOnly

Facultatif

Variant

True pour protéger l'interface utilisateur, mais pas les macros. Si cet argument est omis, la protection s'applique à la fois aux macros et à l'interface utilisateur.

 

[Learning process]

Merci c'est nickel !

 

[Learning process]

De plus, comment faire pour que le compteur ne recommence pas à 0 à chaque fois que je ferme le classeur @mapomme ?

 

[Compte Supprimé 979]

De plus, comment faire pour que le compteur ne recommence pas à 0 à chaque fois que je ferme le classeur ?

Bonjour le fil

Il suffit d'enregistrer le nombre de clic dans une cellule

A+

 

[Learning process]

Bonjour le fil

Il suffit d'enregistrer le nombre de clic dans une cellule

A+

J'ai testé 2-3 choses de mon côté mais je débute en VBA donc je suis perdu . Possible d'avoir de l'aide sur ce point ?

 

[Compte Supprimé 979]

Re,

Après réflexion et bien que je n'ai pas tout compris, est-ce que ça ne suffirait pas comme ça

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  ' Sinon
  If Not Intersect(Range("E2"), Target) Is Nothing Then
    ActiveSheet.Unprotect
    Range("H2").Value = Range("H2").Value + 1
    ActiveSheet.Protect
  End If
End Sub

A+

 

[Learning process]

Merci ça arrive bien à sauvegarder !
Est-il possible d'étendre le programme à plusieurs lignes ? Cad E2-H2, E3-H3, E4-H4 ...

 

[Compte Supprimé 979]

Bonsoir, voici

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  ' Sinon, dans la colonne E2:Ex
  If Not Intersect(Range("E2:E" & Rows.Count), Target) Is Nothing Then
    ActiveSheet.Unprotect
    Range("H" & Target.Row).Value = Range("H" & Target.Row).Value + 1
    ActiveSheet.Protect
  End If
End Sub

A+

 

[Efgé]

Bonjour à tous,
Juste pour le fun :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Nm As Name
Dim FlagNm As Boolean

For Each Nm In ThisWorkbook.Names
    If Nm.Name = "Compteur" Then
        FlagNm = True
        Exit For
    End If
Next Nm

If Not FlagNm Then ThisWorkbook.Names.Add Name:="Compteur", RefersToR1C1:="0", Visible:=True

If Not Intersect(Range("E2:H" & Rows.Count), Target) Is Nothing Then
    With ThisWorkbook
        Tmp = Replace(.Names("Compteur").Value, "=", "")
        Tmp = Tmp + 1
        .Names("Compteur").Delete
        .Names.Add Name:="Compteur", RefersToR1C1:=Tmp
    End With
End If
End Sub

Cordialement

 

[Learning process]

Merci, très pratique ce vba !
Pour information, que faudrait-il modifier pour compter le nombre de clic sur un lien hypertexte plutôt que sur une cellule ?

 

[Efgé]

Bonjour

Pour la version Compteur dans un nom:

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim Nm As Name
Dim FlagNm As Boolean
Dim Tmp&

For Each Nm In ThisWorkbook.Names
    If Nm.Name = "Compteur" Then
        FlagNm = True
        Exit For
    End If
Next Nm

If Not FlagNm Then ThisWorkbook.Names.Add Name:="Compteur", RefersToR1C1:="0", Visible:=True

If Not Intersect(Range("E2:H" & Rows.Count), Range(Target.Range.Address)) Is Nothing Then
    With ThisWorkbook
        Tmp = Replace(.Names("Compteur").Value, "=", "")
        Tmp = Tmp + 1
        .Names("Compteur").Delete
        .Names.Add Name:="Compteur", RefersToR1C1:=Tmp
    End With
End If
End Sub

Cordialement

 

[Learning process]

Je viens de voir qu'en effet on ne peut pas utiliser le code de @BrunoM45 pour compter les activations de liens hypertextes comme cela avait pu marcher pour juste le clic sur la cellule. En effet, le compteur marche pour les liens sauf les liens vers d'autres classeurs Excels. (ci-dessous l'erreur produite)

Merci @Efgé, votre code me permet bien de compter les activations des liens hypertextes, par contre c'est un compteur commun à toute les cellules et la valeur est non affichée, est-ce qu'il vous serait possible d'ajouter la protection de la feuille et la création d'un pour chaque ligne ?

Cordialement

 

[Efgé]

Re

est-ce qu'il vous serait possible d'ajouter la protection de la feuille et la création d'un pour chaque ligne ?

Non

cordialement

 

[Compte Supprimé 979]

Je viens de voir qu'en effet on ne peut pas utiliser le code de @BrunoM45 pour compter les activations de liens hypertextes comme cela avait pu marcher pour juste le clic sur la cellule. En effet, le compteur marche pour les liens sauf les liens vers d'autres classeurs Excels. (ci-dessous l'erreur produite)
Regarde la pièce jointe 1155800

C'est certain quand on ne donne pas le bon énoncé du problème dès le départ