Fade Text In Textbox

Option Explicit


Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'waiting for in milliseconds'




Public Sub WaitForSeconds(ByRef i As Single) 'Function for delay in seconds
  Sleep Int(i * 1000)
End Sub


Sub FadeMeTextbox()


    Dim tboxFade As Shape
    Dim intLetter As Integer
    Dim lngFadeColorIndex(4) As Long
    Dim intFade As Integer
    Dim blnDidFade As Boolean
    Dim intColor As Integer
    Dim lngDelay As Long
    
    lngFadeColorIndex(0) = -4105    ' start color
    lngFadeColorIndex(1) = 16
    lngFadeColorIndex(2) = 48
    lngFadeColorIndex(3) = 15
    lngFadeColorIndex(4) = 2
    
    Set tboxFade = ActiveSheet.Shapes("FadeBox")
    tboxFade.TextFrame.Characters.Font.ColorIndex = xlAutomatic
    
    Select Case Range("Delay").Value
    Case "Easy"
        lngDelay = 500
    Case "Normal"
        lngDelay = 250
    Case "Hard"
        lngDelay = 50
    End Select
    
    intColor = 0
    Do While intColor < 4
        intLetter = 1
        Do While intLetter <= Len(tboxFade.TextFrame.Characters.Text)
            blnDidFade = False
            If tboxFade.TextFrame.Characters(intLetter, 1).Font.ColorIndex = lngFadeColorIndex(intColor) Then
                blnDidFade = True
                intFade = intColor + 1
                Do While intLetter > 0
                    If intFade > 4 Then Exit Do
                    tboxFade.TextFrame.Characters(intLetter, 1).Font.ColorIndex = lngFadeColorIndex(intFade)
                    intLetter = intLetter - 1
                    intFade = intFade + 1
                Loop
                intLetter = 0
                intColor = 0
                Sleep lngDelay
            End If
            intLetter = intLetter + 1
        Loop
        If Not blnDidFade Then intColor = intColor + 1
    Loop
    
End Sub