Hola a todos
estoy haciendo una macro para simular la escritura en directo en un
cuadro de texto de la barra de dibujo. Parece funcionar bastante bien,
pero no logro evitar el parpadeo continuo del cursor mientras se
ejecuta. Explico un poco el funcionamiento (y expongo el codigo al
final).
Lo que hace el codigo es ir 'extrayendo' caracter tras caracter de un
texto depositado en una celda de una hoja (oculta) e irlo concatenando
en el cuadro de texto.
para conseguir un retardo de tiempo que permita ver la secuencia de
'escritura' utilizo una funcion de las APIs (facilitada por HM) que
'crea? retardos de x milisegundos en la ejecucion del codigo (no estoy
seguro de que sea esto lo que haga, pero supongo que sera algo asi).
el problema es que no puedo (o al menos no he podido) usar
App...Screenupdating porque entonces oculta el proceso y muestra solo
el resultado final (el texto completo), y no se si hay otra forma para
evitar el parpadeo del cursor, o al menos intentar atenuarlo al maximo.
el codigo es el siguiente (posiblemente haya formas mejores/mas
eficientes de lograr lo mismo ¿quizas con sendkeys?)
Private Declare Sub Retardo Lib "kernel32" _
Alias "Sleep" (ByVal Milisegundos As Long)
Sub EscribirEnVivoCuadroT()
Dim Pos As Byte, Fin As Byte, lt As String
Dim hj As Worksheet
QuitarTexto 'elimina el cuadro de texto si existe
CrearCuadroTexto 'crea un nuevo cuadro de texto
Set hj = ThisWorkbook.Worksheets("Hoja3")
With Worksheets("Hoja1").Range("a1")
Fin = Len(.Value)
hj.Shapes(1).TextFrame.Characters.Text = ""
For Pos = 1 To Fin
lt = .Characters(Pos, 1).Text
DoEvents
Retardo 130
With hj.Shapes(1)
With .TextFrame
.HorizontalAlignment = xlHAlignCenter
With .Characters
With .Font
.Name = "ZephyrScript"
.Size = 16
End With
.Text = .Text & lt
End With
End With
End With
Next
End With
Set hj = Nothing
End Sub
si podeis echarme una mano de nuevo os lo agradezco
un saludo y hasta pronto
Ivan
Leer las respuestas