Un Reto: Mensaje de texto rotativo

[pkj]

El quitar el ListBox es simple y el código es un regalo.
Si necesitas mejorarlo comentalo. Puede que se me ocurra algo o alguien te lo complete.

Código :

Function AutoTexto(ByVal TextoBase As String) As String
  Dim PosicionInicio As Long
  Dim PosicionFin As Long
  Dim Lista() As String
  Dim Contador As Long
Repite:
  PosicionInicio = InStr(PosicionInicio + 1, TextoBase, "{")
  If PosicionInicio <> 0 Then
    PosicionFin = InStr(PosicionInicio + 1, TextoBase, "}")
    If PosicionFin > PosicionInicio Then
      Contador = Contador + 1
      ReDim Preserve Lista(Contador)
      Lista(Contador) = Mid$(TextoBase, PosicionInicio + 1, PosicionFin - PosicionInicio - 1)
      TextoBase = Left$(TextoBase, PosicionInicio - 1) & "TextoVariable" & Contador & Mid$(TextoBase, PosicionFin + 1)
      PosicionInicio = 0
      GoTo Repite
    End If
  End If
  Dim Opciones() As String
  Dim Eleccion As String
  Dim F As Long
  Randomize Timer
  For F = 1 To UBound(Lista)
    Opciones = Split(Lista(F), "|")
    Eleccion = Opciones(Rnd * UBound(Opciones))
    TextoBase = Replace(TextoBase, "TextoVariable" & F, Eleccion)
  Next F
  AutoTexto = TextoBase
End Function
 

Saludos