Faire apparaître un nom lentement

Bonjour

J'essai de faire un fichier pour un tirage d'une tombola. je voudrais que le nom du gagnant soit divulguer au bout de quelques secondes... genre une couleur qui s'efface tout doucement ...

Je joins-mon fichier test .... au cas ou quelqu'un aura une petite idée

D'avance merci

Ma

Hello,

je te propose une possibilité en VBA (classeur de type xlsm) :

1 - Plus de formule , c'est le VBA qui va chercher le gagnant.

2 - Au lieu d'avoir un nom qui apparaît progressivement, des lettres s'affichent aléatoirement toutes les 200 ms pendant 5 secondes avant d'afficher le nom du vainqueur.

code de feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Vérifie si la cellule modifiée est BO1
    If Not Intersect(Target, Me.Range("BO1")) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value <> "" Then
            Call TombolaAvecAnimation
        End If
    End If
End Sub

code dans un module :

Sub TombolaAvecAnimation()
    Dim ws As Worksheet
    Dim numRecherche As Long
    Dim plage As Range
    Dim cellule As Range
    Dim ligneTrouvee As Long
    Dim nomTrouve As String
    Dim i As Integer, j As Integer
    Dim affichage As String
    Dim lettres As String

    Set ws = ActiveSheet
    numRecherche = ws.Range("BO1").Value    
    ' Plage des numéros (colonnes K à BH, lignes 3 à 142)
    Set plage = ws.Range("K3:BH142")   
    ligneTrouvee = 0   
    ' Recherche du numéro
    Set cellule = plage.Find(What:=numRecherche, LookIn:=xlValues, LookAt:=xlWhole)
    If Not cellule Is Nothing Then
        ligneTrouvee = cellule.Row
        ' Le nom est en colonne J de la même ligne
        nomTrouve = ws.Cells(ligneTrouvee, "J").Value
    Else
        ws.Range("BM3").Value = "Numéro introuvable"
        Exit Sub
    End If  
    ' Compléter à 20 caractères avec des espaces
    If Len(nomTrouve) < 20 Then
        nomTrouve = nomTrouve & String(20 - Len(nomTrouve), " ")
    ElseIf Len(nomTrouve) > 20 Then
        nomTrouve = Left(nomTrouve, 20)
    End If    
    ' Alphabet pour tirage aléatoire
    lettres = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"    
    ' Animation pendant 5 secondes (25 cycles)
    For i = 1 To 25
        affichage = ""
        For j = 1 To 20
            affichage = affichage & Mid(lettres, Int(Rnd() * 52) + 1, 1)
        Next j
        ws.Range("BM3").Value = affichage
        PauseAff
    Next i

    ' Révélation du vrai nom
    ws.Range("BM3").Value = nomTrouve
End Sub

' Fonction pause de 200 ms
Sub PauseAff()
    Dim t As Double
    t = Timer
    Do While Timer < t + 0.2
        DoEvents
    Loop
End Sub

Voilà ce que cela donne :

Ami calmant, J.P

Bonsoir JP

Je ne dirai pas bien , ni très bien mais génial !!!! Merci infiniment Jurassic, je trouve ça super.

Solution merveilleuse , épatante

Je la glisse dans mon projet ...

En core un grand merci pour le temps passé et la solution proposée.

Cdlt

Ma