Incremento de tiempo en for... next

Timer-función:

Public Sub TimerDemo()
Wait (5)
MsgBox "5 seconds done"
End Sub

Private Sub Wait(secs As Double)
Dim startTime
startTime = Timer
Do While Timer < startTime + secs
DoEvents
Loop
End Sub





"Ivan" schreef in bericht
news:
Hola a todos

estoy intentando hacer un bucle con OnTime para ejecutar un
procedimiento cada segundo durante 5 segundos. Seguramente estoy
haciendo una burrada, pero tras varias pruebas con diferentes errores,
he acabado intentando hacer un bucle poniendo como contador una
variable date, pero aunque no hay errores, no se produce ningun
resultado.

Expongo el codigo, que posiblemente sea mas explicito:

Dim Aum As Date, Salida As Boolean
Dim Alt As Double, Anch As Double


Sub FotoCreciente()
Dim Nueva As Date
Nueva = Now
With Image1
Alt = .Height: Anch = .Width
For Aum = TimeValue("00:00:01") To TimeValue("00:00:05")
Nueva = Nueva + Aum
Application.OnTime Nueva, "AumentarFoto"
If Salida = True Then
Application.OnTime Nueva, "AumentarFoto", , False
Exit Sub
End If
Next
End With
End Sub

como indica el nombre del procedimiento, se trata de ir aumentando un
formulario y una imagen contenida en un control image hasta un tamaño
determinado durante 5 segundos

Este es el codigo "AumentarFoto"

Sub AumentarFoto()
Salida = False
With Image1
Me.Height = Alt + 108
.Height = Alt + 108
Me.Width = Anch + 168
.Width = Anch + 168
If Alt >= 540 Or Anch >= 840 Then Salida = True
End With
End Sub

Si podeis ayudarme os lo agradezco

un saludo y hasta pronto
Ivan

hola, Ivan !

estoy intentando hacer un bucle con OnTime para ejecutar un procedimiento cada segundo durante 5 segundos...
he acabado intentando... un bucle poniendo como contador una variable date, pero aunque no hay errores, no se produce ningun resultado...

1) necesitas hacer una 'llamada' a la API de windows 'Sleep' en el modulo/libreria 'Kernel32'
para 'manipular' un retardo en la secuencia ->por milesimas de segundo<-
[probablemente] debieras agregar una instruccion 'DoEvents' [para no 'interferir' con otros procesos]
-> [encontraras la informacion =>traducida al castellano<= en...]
WD97 Como Implementar un Retardo en Visual Basic para Aplicaciones
http://support.microsoft.com/suppor...2/1/50.asp

2) has unas pruebas con codigos +/- como lo siguiente:

Private Declare Sub Retardo Lib "kernel32" Alias "Sleep" (ByVal Milisegundos As Long)

Sub Cada_X_Segundos()
Dim Segundos As Integer
For Segundos = 1 To 5
Retardo 1000 ' <= 1000, 'equivale' a 1 segundo [mil milisegundos] ;) '
ActiveCell.Font.Size = ActiveCell.Font.Size + 1
' o llamas al procedimiento para 'aumentar la foto' SIN la variable booleana de 'Salida' <= OJO '
Next
End Sub

saludos,
hector.

__ el resto del mensaje __
Dim Aum As Date, Salida As Boolean
Dim Alt As Double, Anch As Double

Sub FotoCreciente()
Dim Nueva As Date
Nueva = Now
With Image1
Alt = .Height: Anch = .Width
For Aum = TimeValue("00:00:01") To TimeValue("00:00:05")
Nueva = Nueva + Aum
Application.OnTime Nueva, "AumentarFoto"
If Salida = True Then
Application.OnTime Nueva, "AumentarFoto", , False
Exit Sub
End If
Next
End With
End Sub

como indica el nombre del procedimiento, se trata de ir aumentando un formulario y una imagen
contenida en un control image hasta un tama#o determinado durante 5 segundos

Este es el codigo "AumentarFoto"
Sub AumentarFoto()
Salida = False
With Image1
Me.Height = Alt + 108
.Height = Alt + 108
Me.Width = Anch + 168
.Width = Anch + 168
If Alt >= 540 Or Anch >= 840 Then Salida = True
End With
End Sub

Hola Moon y Hector Miguel, lo primero muchas gracias.

espero que no os importe que aunque la respuesta es para ambos, la vaya
personalizando un poco sobre la marcha

Moon, he hecho una adaptacion de tu codigo, que, aunque no se si es muy
correcta, pues no estoy muy familiarizado todavia con los bucles
Do...Loop ni con DoEvents, parece funcionar bastante bien. La verdad es
que recorde el metodo OnTime de haberlo visto en algunos mensajes del
foro, y no se me ocurrio tantear otras opciones como Timer. El codigo
lo expongo al final del mensaje para recabar vuestra opinion.

Hector Miguel, aunque acabo de leer tu mensaje, y la pagina que me has
facilitado, todavia no he tenido tiempo de estudiarlo. Pero puede ser
muy interesante, pues realmente la intencion de mi mensaje era
conseguir un punto de partida para poder ir aumentando la imagen en
secuencias mucho mas pequeñas, tanto de tiempo, como de tamaño, para
conseguir una especie de animacion con imagenes que irian surgiendo de
una esquina (pej.) de la pantalla, aumentando hasta un tamaño
determinado, y disminuyendo hasta quedar fijadas en un tamaño pequeño
en un punto determinado (o hasta desaparecer). Para esto, los
milisegundos quizas sean fundamentales. Permiteme estudiarlo un poco y
os vuelvo a responder con el resultado de mis intentos.

el nuevo codigo de momento es este:

Sub FotoCreciente()
Dim Iniciar, Fin
With Image1
Iniciar = Timer
For Fin = 1 To 4
Alt = .Height: Anch = .Width
Do While Timer < Iniciar + Fin
DoEvents
AumentarFoto
Loop
Next
End With
End Sub

Sub AumentarFoto()
With Image1
Me.Height = Alt + 108
.Height = Alt + 108
Me.Width = Anch + 168
.Width = Anch + 168
End With
End Sub


Muchas gracias a ambos de nuevo

Un saludo y hasta pronto
Ivan

Hola Hector Miguel y Moon (y resto de 'aforados')

como en mi mensaje anterior espero que no os moleste que personalice mi
mensaje

Hector Miguel, he estado haciendo pruebas con el codigo y la
informacion que me has facilitado, y poco a poco parece que voy
consiguiendo algo, aunque a cada milisegundo me encuentro con una nueva
sorpresa. He decidido hacer pruebas prescindiendo del formulario y
colocando las imagenes directamente en una hoja.

Como mi experiencia con imagenes hasta hoy era =0 (practicamente igual
que con el manejo de los 'tiempos', por no hablar de DoEvents), la
verdad es que voy despacito, metiendo la pata continuamente y
seguramente haciendo/poniendo mas de una burrada.

Lo que consultaba en el primer mensaje esta mas o menos logrado con un
incremento notable en velocidad gracias a 'kernel32' (mas bien a HM),
pero se me ha ocurrido seguir jugueteando con algunas propiedades y
metodos del objeto Shape, de cara a 'animar' las fotogarfias (bueno de
momento solo me he atrevido a practicar con una) y me ha ocurrido una
cosa cuanto menos curiosa, que no se muy bien a que achacar.

Cuando cambio de usar un codigo que parece funcionar sin problemas a
otro que inicialmente parece tambien funcionar bien, al menos en las
primeras pruebas, pero ya incluyendo movimiento de la imagen, de
repente, al cabo de varias pruebas, la imagen desaparece, o en su
defecto se queda reducida a un infimo punto en la parte superior de la
pantalla. Y lo mas curioso es que aunque elimine la imagen y vuelva a
poner el codigo que desde un principio parecia funcionar bien (sin
movimiento), solo consigo que me coloque la imagen como un micropunto
en la parte superior izq. de la pantalla.

Lo mejor quizas sea que te lo intente explicar a traves de los codigos:

1.-Este es el primer codigo con el que se consigue un aumento
considerablemente rapido del tamaño de la foto. Para mantener la foto
pegada a la esqina superior de la ventana parece ir bastante bien. Los
valores para height, width y milseg son totalmente aleatorios, sacados
mediante ensayos para dejarlo con un aspecto mas os menos decente.
Hasta aqui todo va bien, pero falta la animacion.

Sub ProbarFoto()
Dim MiHj As Worksheet, MilSeg As Long
Set MiHj = ThisWorkbook.Worksheets(1)
MiHj.Shapes.AddPicture("C:\Documents and Settings\Ivan\" & _
"Mis documentos\Mis imágenes\Imágenes Kodak\" & _
"Foto1.jpg", msoTrue, msoFalse, 0, 0, 3.5, 5) _
.LockAspectRatio = msoTrue
With MiHj.Shapes(1)
For MilSeg = 1 To 50
DoEvents
Retardo 1
.Height = .Height + 3: .Width = .Width + 3
Next
End With
End Sub

2.-Este es el ultimo codigo que he estado usando despues de otros
muchos que me mandaban la foto como un ovni hacia reconditos lugares de
la hoja. Parecia haber conseguido que la foto hiciera un recorrido
visible por la pantalla, y ha funcionado bien varias veces, pero de
repente la foto ha desaparecido y no ha habido manera de encontrarla.
He cerrado el libro sin guardar cambios, he empezado por el principio,
y de nuevo parecia funcionar, pero de repente 'plaff', otra vez. Esta
vez ni cerrando el libro consigo que la foto pase del infimo punto. De
nuevo los valores asignados vienen de probar y probar.

Sub ProbarFoto()
Dim MiHj As Worksheet
Dim MilSeg As Long
Dim Sup As Double, Lat As Double
Set MiHj = ThisWorkbook.Worksheets(1)
MiHj.Shapes.AddPicture("C:\Documents and Settings\Ivan\" & _
"Mis documentos\Libreria 3-7\Introduccion\Foto1.jpg", msoTrue, _
msoFalse, 0, 0, 3, 3).LockAspectRatio = msoTrue
With MiHj.Shapes(1)
.Placement = xlFreeFloating
Sup = .Top: Lat = .Left
For MilSeg = 2 To 100
DoEvents
Retardo 1
.Height = .Height * (MilSeg / (MilSeg - 1))
.IncrementLeft Lat + (MilSeg / 10)
If MilSeg < 51 Then
.IncrementTop Sup + (MilSeg / 10)
ElseIf MilSeg > 50 Then
.IncrementTop Sup - ((100 - MilSeg) / 10)
End If
Next
End With
End Sub

Bueno no se si se me ha entendido algo, pero lo mismo hay alguna
burrada en los codigos que yo no veo. O quizas existan maneras mas
'propias' de manipular imagenes en una hoja.

Bueno, si veis algo, por aqui ando, en busca de la foto perdida.

En cualquier caso muchas gracias.

Un saludo y hasta pronto
Ivan

Hola de nuevo

efectivamente, habia (seguro que aun hay) mas de una burrada. Entre
ellas, la que parece mas gorda y provocaba el problema, creo que era el
incremento de Top Y Left, que no se muy bien de donde me lo he sacado,
con lo facil que es poner +1 o -1

bueno, de momento, he conseguido que la foto tenga un movimiento
racional. Ahora falta ajustar las posiciones.

¿como se pueden conocer las cordenadas de pantalla, o de una hoja de
excel, para saber cuantos puntos incrementar una posiscion tratandose
de imagenes o formas?

y otra pregunta: ¿como puedo saber el tamaño (¿en puntos?) con que
me va a abrir excel una foto?y si el tamaño es igual al original¿como
lo traduzco a puntos, que creo que es en lo que la mide excel?

Si podeis ayudarme os lo agradezco.

Un saludo y hasta pronto
Ivan

PD: este es el nuevo codigo de momento

Sub ProbarFoto()
Dim MiHj As Worksheet, MilSeg As Long
Set MiHj = ThisWorkbook.Worksheets(2)
MiHj.Shapes.AddPicture("C:\Documents and Settings\Ivan\" & _
"Mis documentos\Libreria 3-7\Introduccion\Foto1.jpg", msoTrue, _
msoFalse, 0, 0, 3, 3).LockAspectRatio = msoTrue
With MiHj.Shapes(1)
.Placement = xlFreeFloating
For MilSeg = 2 To 100
DoEvents
Retardo 1
.Height = .Height * (MilSeg / (MilSeg - 1))
.IncrementLeft 1
If MilSeg < 51 Then
.IncrementTop 1
ElseIf MilSeg > 50 Then
.IncrementTop -1
End If
Next
End With
End Sub