Compteur Username

[Florian53]

Bonjour le forum,

Je voudrais avoir un code à l'ouverture du classeur qui incrémente de 1 à chaque ouverture du fichier excel, même si il y aura des manques du au fait que le fichier peut être ouvert mais pas enregistrer ce n'ai pas très grave.

J'ai essayé avec ce code mais il ne fonctionne pas, pouvez vous me guider ?

Private Sub Workbook_Open()

Set Usn = Sheets("List").Columns("A").Find(what:=Application.UserName, LookIn:=xlValues, lookat:=xlWhole)
Ligne = Sheets("List").Range("A65536").End(xlUp).Offset(1, 0).Row

  If Not Usn Is Nothing Then
Cells(Usn, 2).Value = Cells(Ligne, 2).Value + 1
  Else
    Sheets("List").Range("A" & Ligne).Value = Application.UserName
  Cells(Ligne, 1).Value = Application.UserName
  Cells(Ligne, 2).Value = "1"
End If
End Sub

Merci à vous

 

[DoubleZero]

Bonjour, Florian53, le Forum,

Comme ceci ?

Option Explicit
Private Sub Workbook_Open()
    Dim c As Range, qui
    Application.ScreenUpdating = False
    On Error Resume Next
    With Sheets("List")
        For Each c In .Range("a1:a" & Rows.Count).SpecialCells(xlCellTypeConstants)
            Set qui = .Range("a:a").Find(Application.UserName, LookIn:=xlValues, LookAt:=xlWhole)
            If Not qui Is Nothing Then
                qui(1, 2) = qui(1, 2) + 1
            Else
                .Range("a" & Rows.Count).End(xlUp)(2) = Application.UserName
                .Range("b" & Rows.Count).End(xlUp)(2) = 1
            End If
        Next
    End With
    Me.Save
    Application.ScreenUpdating = True
End Sub

A bientôt

 

[DoubleZero]

Re-bonjour,

Si l'onglet "List" doit être masqué, il est préférable d'utiliser ...

Dans ThisWorkbook :

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Sheets("List").Visible = xlVeryHidden
End Sub
Private Sub Workbook_Open()
    Dim c As Range, qui
    Application.ScreenUpdating = False
    On Error Resume Next
    With Sheets("List")
        .Visible = True
        For Each c In .Range("a1:a" & Rows.Count).SpecialCells(xlCellTypeConstants)
            Set qui = .Range("a:a").Find(Application.UserName, LookIn:=xlValues, LookAt:=xlWhole)
            If Not qui Is Nothing Then
                qui(1, 2) = qui(1, 2) + 1
            Else
                .Range("a" & Rows.Count).End(xlUp)(2) = Application.UserName
                .Range("b" & Rows.Count).End(xlUp)(2) = 1
            End If
        Next
        .Visible = xlVeryHidden
    End With
    Me.Save
    Application.ScreenUpdating = True
End Sub

Dans un module standard :

Option Explicit
Sub Onglet_List_afficher()
    Dim mdp
    mdp = InputBox("Saisir le mot de passe.")
    If mdp = "toto" Then
        With Sheets("List"): .Visible = True: .Activate: End With
    End If
End Sub

A bientôt

 

[Florian53]

Merci à vous je test les solutions et je vous tiens au courant

 

[Florian53]

sa fonctionne bien, le problème est qu'il incrémente de 3 voir 4 à chaque ouverture. j'ai l'impression que l'incrémentation est aléatoire.

j'ai ajouté ce code afin qu'il n'enregistre pas si le fichier est en lecture seul, est ce à cause de celà ?

Private Sub Workbook_Open()

Dim c As Range, qui
    Application.ScreenUpdating = False
    If ActiveWorkbook.ReadOnly = True Then
    Sheets("Feuil1").Activate
    Range("A1").Select
    Else
   
    On Error Resume Next
    With Sheets("List")
        .Visible = True
        For Each c In .Range("a1:a" & Rows.Count).SpecialCells(xlCellTypeConstants)
            Set qui = .Range("a:a").Find(Application.UserName, LookIn:=xlValues, LookAt:=xlWhole)
            If Not qui Is Nothing Then
                qui(1, 2) = qui(1, 2) + 1
            Else
                .Range("a" & Rows.Count).End(xlUp)(2) = Application.UserName
                .Range("b" & Rows.Count).End(xlUp)(2) = 1
            End If
        Next
        .Visible = xlVeryHidden
    End With
    Me.Save
    Application.ScreenUpdating = True
    Sheets("Feuil1").Activate
    Range("A1").Select
    Exit Sub
    End If
End Sub

 

[DoubleZero]

Bonjour, Florian53, le Forum,

... il incrémente de 3 voir 4 à chaque ouverture. j'ai l'impression que l'incrémentation est aléatoire...

?

C'est curieux !

Sans aucune certitude, peut-être ainsi :

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Sheets("List").Visible = xlVeryHidden
End Sub
Private Sub Workbook_Open()
    Dim c As Range, qui
    Application.ScreenUpdating = False
    On Error Resume Next
    If ThisWorkbook.ReadOnly = True Then Exit Sub
    With Sheets("List")
        .Visible = True
        For Each c In .Range("a1:a" & Rows.Count).SpecialCells(xlCellTypeConstants)
            Set qui = .Range("a:a").Find(Application.UserName, LookIn:=xlValues, LookAt:=xlWhole)
            If Not qui Is Nothing Then
                qui(1, 2) = qui(1, 2) + 1
            Else
                .Range("a" & Rows.Count).End(xlUp)(2) = Application.UserName
                .Range("b" & Rows.Count).End(xlUp)(2) = 1
            End If
        Next
        .Visible = xlVeryHidden
    End With
    Me.Save
    Application.ScreenUpdating = True
End Sub

A bientôt

 

[Florian53]

C'est pareil, est ce que ce n'ai pas du à cette ligne là :

qui(1, 2) = qui(1, 2) + 1

si je comprends bien, il additionne "1" à la valeur cellule "B2" ?

En fait il y aura une liste de Username avec different nombre de connexion, donc il faudrait qu'il incrémentechaque Usersame de 1 à chaque connexion.
Et j'ai l'impression que cette ligne de code prends une valeur d'une cellule fixe et non dynamique.

Est ce que je me trompes ?

 

[DoubleZero]

Re-bonjour,

Un fichier à tester... Je l'ai ouvert quatre fois et le total, en regard de mon nom, est correct.

A bientôt

 

[Florian53]

Merci à toi Doublezero, en fait sa fonctionne bien si il y a qu'un seul utilisateur ( si seul la ligne 2 est remplie) quand j'ai pris ton fichier et que je l'ai ouvert j'ai eu une dans les"14400" en B3, j'ai renommé la la cellule A3 afin de recommencer et la mon username apparaissait en A4 (Normal) mais ma valeur était à 3.

 

[DoubleZero]

Re-bonjour,



Je ne sais plus que faire ! Attendons l'aide de membres experts.

A bientôt

 

[Florian53]

est ce que vous retrouvez le meme probleme lors de plusieurs utilisateur ?

 

[DoubleZero]

Re-bonjour,

est ce que vous retrouvez le meme probleme lors de plusieurs utilisateur ?

Je n'en ai aucune idée...

 

[Florian53]

Si vous l'ouvrez 2 fois , la valeur ne sera pas bonne

 

[DoubleZero]

Re-bonjour,

Si vous l'ouvrez 2 fois , la valeur ne sera pas bonne

Saperlippette ! Pour l'heure, je ne vois pas où se trouve la bulette.

A bientôt

 

[Florian53]

sa fonctionne chez vous ?