XL 2010 code Danreb UserForm (temps en millisecondes)

[Usine à gaz]

Bonjour à toutes et à tous,

Je suis "tombé" sur le classeur de Danreb (pièce jointe) que j'apprécie beaucoup pour ses possibilités.
Dans votre fichier, il y a un code (dans votre UserForm) que j'aurais aimé insérer dans mon code.
votre code :

Public Sub Conclure()
Dim T As Double, S() As String, M As Double, E As Long
QueryPerformanceCounter Top
T = CDbl(Top - TopDépart) / CDbl(DTop1sec)
SMin = 1: SMax = 1: Visu 1: Me.Height = 54: Me.Caption = "Tirage réussi."
Select Case T
   Case Is < 10: S = Split(Format(T, "000.E+00"), "E"): E = S(1) \ 3: M = S(0) * 10 ^ S(1) * 1000 ^ -E
                  LabFait.Caption = Choose(1 - E, "Dénoué", "Réglé", "Aperçu") & " en " _
      & M & " " & Choose(1 - E, "", "milli", "micro") & "seconde" & IIf(M > 1, "s", "") & "."
   Case Is < 60:  LabFait.Caption = "Dépêtré en " & Int(T * 10 + 0.5) / 10 & " seconde" & "."
   Case Else:     LabFait.Caption = "Achevé en " & DuréeEnClairSec(T) & "."
   End Select
Terminé = True: MessageBeep vbInformation: Décharger.PlanifierDans 5
End Sub

Mon code :

Private Sub RechercheQuoi(Quoi As Variant)
'Application.EnableEvents = False
'Application.ScreenUpdating = False
Dim Sh As Worksheet, Trouve As Range, SvgAdres$, T$, M$, F$, AdresSource$

F$ = ActiveSheet.Name
Select Case F$
  Case "SuivisAppels": AdresSource$ = "A1"
  Case Else: Exit Sub '
End Select

T = "Pas"
'Quoi = Format(Quoi, "0#"" ""##"" ""##"" ""##"" ""##")'< ceci uniquement si tu veux rechercher avec no formaté
'boucle feuilles
For Each Sh In Worksheets
    Set Trouve = Sh.Cells.Find(Quoi, LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    If Not Trouve Is Nothing Then
       Sh.Activate: SvgAdres = Trouve.Address
       'n'affiche pas la cellule source
       If Trouve.Address(False, False) <> AdresSource$ Then
       On Error Resume Next
  
       Call Conclure
          If ActiveSheet.Name = "SuivisAppels" Then
          Trouve.Offset(0, -2).Select
          Else
          Trouve.Offset(0, 0).Select
          End If
     
          M$ = "Trouvé !" & vbLf & "Feuille: " & Sh.Name & vbLf & "Adresse: " & Trouve.Address(False, False) & vbLf & vbLf & "Recherche suivant ?"
     
           If ActiveSheet.Name = "SuivisAppels" Then
            ActiveSheet.Unprotect Password:="Krameri"
            Selection.RowHeight = 130
            ActiveSheet.Protect Password:="Krameri", DrawingObjects:=True, Contents:=True, Scenarios:=True
            ActiveSheet.EnableSelection = xlNoRestrictions
            End If
     
          If MsgBox(M$, vbYesNo, "Recherche de " & Quoi) = vbNo Then Exit Sub 'MsgBox "Recherche arrêtée !", , "Oups":
          T = "Plus "
       End If
       '
       Do 'boucle sur même feuille
         Set Trouve = Sh.Cells.FindNext(Trouve)
         If Trouve Is Nothing Then Exit Do 'en 1'
         If Trouve.Address = SvgAdres Then Exit Do 'si retour à la 1'trouvée exit do feuil.suivante
         T = "Plus ": Trouve.Select
         M$ = "Trouvé !" & vbLf & "Feuille: " & Sh.Name & vbLf & "Adresse: " & Trouve.Address(False, False) & vbLf & vbLf & "Recherche suivant ?"
         If MsgBox(M$, vbYesNo, "Recherche de " & Quoi) = vbNo Then Exit Sub 'MsgBox "Recherche arrêtée !", , "Oups":
       Loop
    End If
Next
If T = "Pas" Then
  MsgBox "Recherche infructueuse !", , "Oups"
Else
  MsgBox "Recherche terminéee !", , "Très bon boulot ..."
End If

Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

J'ai copié votre code tel quel dans le code de l'UserForm et ajouté un Call.
Je voudrais donc cet affichage :

Mais ça marche pas et je ne trouve pas comment faire.

Amicalement,
Lionel,

 

[Dranreb]

Bonjour.
Ça aura des chance d'être plus simple, là, si ce n'est pas un UserForm à propriété ShowModal à False.
La 1ère chose c'est de mettre en tête de l'UserForm:

Option Explicit
Private Declare Function QueryPerformanceFrequency Lib "Kernel32" (X As Currency) As Boolean
Private Declare Function QueryPerformanceCounter Lib "Kernel32" (X As Currency) As Boolean
Private TopDépart As Currency, DTop1sec As Currency
Private Sub UserForm_Initialize()
QueryPerformanceFrequency DTop1sec
End Sub

Au démarrage de l'action dont vous voulez mesurer la durée:

QueryPerformanceCounter TopDépart

 

[Usine à gaz]

LOL j'suis toujours un rigolo en vba.
Je vais ça.
Merci Dranreb 😉

 

[Usine à gaz]

J'ai testé mais ça plante.
J'aurais bien aimé mais ça ne vaut pas la peine de vous faire perdre votre temps (je peux travailler sans ça LOL)
Je ne veux pas vous faire perdre votre temps d'autant que le code que je vous ai mis n'est qu'une partie du code complet.
Je chercherai et je finirai (peut-être 😕) par trouver.
Merci encore d'avoir été là Dranreb.
Amicalement,
Lionel,

 

[Dranreb]

Il faut aussi un peu modifier :

Private Sub Conclure()
Dim Top As Currency, T As Double, S() As String, M As Double, E As Long
QueryPerformanceCounter Top
T = CDbl(Top - TopDépart) / CDbl(DTop1sec)
Select Case T
   Case Is < 10: S = Split(Format(T, "000.E+00"), "E"): E = S(1) \ 3: M = S(0) * 10 ^ S(1) * 1000 ^ -E
                  LabInfo.Caption = Choose(1 - E, "Dénoué", "Réglé", "Aperçu") & " en " _
      & M & " " & Choose(1 - E, "", "milli", "micro") & "seconde" & IIf(M > 1, "s", "") & "."
   Case Is < 60:  LabInfo.Caption = "Dépêtré en " & Int(T * 10 + 0.5) / 10 & " seconde" & "."
   Case Else:     LabInfo.Caption = "Achevé en " & DuréeEnClairSec(T) & "."
   End Select
End Sub

Si vous avez prévu un Label nommé LabInfo pour afficher ça, sinon mettre des MsgBox…

 

[Usine à gaz]

Merci Dranreb 🙂,
Je vais voir.