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]

Re-bonjour,

sa fonctionne chez vous ?

Le fonctionnement du fichier déposé en #8 était correct, avec le vôtre, les valeurs en b sont fausses :

Je ne comprends pas ces résultats.

A bientôt

 

[Florian53]

Je ne comprends pas votre réponse, dites vous que le fichier du #8 fonctionne correctement pour vous ? ou que le fichier ne fonctionne pas car les valeurs ne sont pas bonnes ?

 

[Florian53]

Re bonsoir,

Je pense avoir trouvé, en tout cas sa a l'air de fonctionner . J'ai enlevé la boucle "For Each"

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
            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
        .Visible = xlVeryHidden
    End With
    Me.Save
    Application.ScreenUpdating = True
End Sub

 

[DoubleZero]

Bonjour à toutes et à tous,

... Je pense avoir trouvé, en tout cas sa a l'air de fonctionner . J'ai enlevé la boucle "For Each"...

Un grand brav, Florian53 ! J'aurais dû y penser ...

En pièce jointe, une autre façon d'agir.

A bientôt

 

[Florian53]

Merci DoubleZero votre solution fonctionne à merveille.

Encore un grand merci pour votre aide