Serie ficheros virtuales



VBA. Ficheros virtuales





VBA Ficheros Virtuales. Temporizador y Generador Aleatorio

1 Introducción
2 Generadores aleatorios. El módulo R
3 Temporizadores. La ampliación del módulo F

                                                                                                ________



1 Introducción

Con la vista puesta en el objetivo de replicar el desarrollo de Sudokus bajo VBA-Excell, se precisan algunos desarrollos de transición relativos a generadores aleatorios sin repetición y tratamiento de temporizadores en VBA.

Este capítulo auxiliar está dedicado a estos desarrollos.


                                                                                                ________

2 Generadores aleatorios. El módulo R

Para los generadores se centralizan los desarrollos en el módulo R, cuyo su representante principal es R_RNR que se encarga de la extracción de números sin repetición cebados previamente con la función R_RNR_GEN.


Visualmente podemos construir una hoja como la siguiente


En la que en A1 se introduce el número de ítems a generar y al pulsar el botón se cargan y presentan en la línea 2 utilizando R_RNR_GEN, indicando en la celda B1 el identificador asignado.

La rutina continúa extrayendo al azar y sin repetición los distintos ítems hasta su agotamiento con R_RNR, presentándose los diversos restos que van quedando a efectos de ilustración gráfica.

                                                                                                ________


El código de estas dos rutinas maestras es sencillo y se transpone a continuación

'//-----------------------------------------------------------------------------
'// Rutina auxiliar de recuperación de un item de lista ordenada
'//
'// Precondición
'//              La lista contiene n elementos (1..n..N) [N Tamaño original. Usar W_INF para recuperarlo]
'//
'// Postcondición
'//              Se extrae un ítem al azar y la lista pasa a contener n-1 elementos disponibles
'//
'// Parámetros
'//            sFILE: Nombre de la lista objeto de la extracción
'//
'// Valor de retorno
'//                  0 Lista agotada
'//                 >0 Item aleatorio de entre los disponibles de la lista
'//-----------------------------------------------------------------------------
Function R_RNR(sFILE As String) As Long
 
 Dim Er As Integer  ' Control de errores intermedios
 Dim lResul As Long ' Control de resultados intermedios
 Dim n As Long      ' NºDe ítems disponibles
 Dim k As Long      ' Random auxiliar 1..n
 Dim sR As String   ' Random extraído de la lista
 
 
 ' Inz
 
 R_RNR = 0
 
 
 ' Filtro
 
 n = R_RNR_INF(sFILE) ' Interfaz a W_INF
 If n <= 0 Then Exit Function
 
 
 ' Random para la extracción
 
 k = R_LRnd(n)  ' 1 + Rnd * n
 
 
 ' Extrae el k-ésimo ítem de la lista
 
 Er = W_READ(sFILE, k, sR)
 If Er > 0 Then Exit Function
 
 
 ' Elimina el ítem consumido y lo retorna
 
 lResul = W_DELETE(sFILE, sR)
 If lResul <= 0 Then Exit Function
 
 R_RNR = CLng(sR)
 
End Function

                                                                                                ________


'-----------------------------------------------------------------------------------
' R_RNR_GEN
'
' Rutina de (Re)Generación de una serie para extracción de muestras aleatorias sin repetición
'
' Parámetros:
'            sFILE: Nombre de la lista de números a generar
'            N    : NºDe ítems de lista
'
' Valor de retorno
'                 NID de la lista generada. Si es nulo indica error (Memoria agotada)
'
'-----------------------------------------------------------------------------------
Function R_RNR_GEN(sFILE As String, n As Long) As Long
 
 Dim sName As String * 33 ' Normalización de sFILE
 Dim l As Long            ' Contador de for
 Dim lResul As Long       ' Control de resultados intermedios
 Dim lNID As Long         ' Identificador de la lista generada


 ' Inz
 
 R_RNR_GEN = 0
 
 
 ' Normaliza nombre
 
 sName = W_NAME(sFILE)


 ' Inicia un nuevo fichero virtual de soporte rand sin repetición

 lNID = W_NEW(sName, 10) ' Slong k
 If lNID <= 0 Then Exit Function
 
 R_RNR_GEN = lNID


 ' Ceba la lista
 
 For l = 1 To n
 
   lResul = R_RNR_WRITE(sName, l) ' Interfaz a W_Write
  
 Next l


End Function


                                                                                                ________


El código fuente completo completo se encuentra en el módulo R que se integra en la hoja de muestra RNR

                                                                                                ________

3 Temporizadores

Por otro lado, en la versión del sudoku del primer blog se utilizaba un temporizador. Aquí lo he experimentado construyendo un pequeño reloj de muestra junto con las funciones auxiliares que amplian el módulo F del componente W.

Es interesante señalar que la función ON TIME funciona perfectamente bajo interfaz hoja, pero que si se añade un formulario y se solicita, el temporizador queda a la espera de la respuesta al mismo mientras este está activo.

También hay que tener cuidado de no ejecutar el código desde un módulo común a un libro, porque se actualizarían todas las hojas, si no que el “autocódigo” debe ser propietario de la hoja concreta a actualizar.



Gráficamente el reloj tendría este aspecto

 



En donde en A1 se presenta la fecha (Date), en B1 la hora actual (Time), en C1 la diferencia temporal entre la hora actual y la de activación del reloj con el botón, en D1 la misma diferencia expresada en segundos y en E1 el tiempo en el momento de activación del reloj con el botón.



                                                                                                ________


Las sentencias de hoja fundamentales son


' Interfaz de invocación a Reloj_Marco por boton

Sub Auto_Reloj_Macro()

 
 ' Progresa semáforo y establece estado
 
 iAuto = iAuto + 1
 
 If iAuto = 1 Then Range("C2") = "  Activo"
 
 If iAuto >= 2 Then
    
     
    ' Estado
    
    iAuto = 0
    nAuto = 0
    
    Range("C2") = " Parado"
 

 End If
    
    
 ' Time en punto 0 (Activo o parado)
    
 t0 = Time           ' Time en punto 0
 st0 = t0            ' En formato HH:SS:MM alfanumerico
 lt0 = F_TimeS(st0)  ' En formato HHMMSS long
    
 Range("E1") = t0    ' Pasa time en punto 0


 
 ' Ejecuta rutina reloj núcleo
 
 Hoja1.Reloj_Macro
 
 
End Sub



' Auto reloj

Sub Reloj_Macro()

 Dim t               ' Time actual
 Dim st As String    ' t en formato string
 Dim lt As Long      ' t en formato long
 Dim t1              ' Time actual + 1
 Dim st1 As String   ' t1 en formato string
 Dim lt1 As Long     ' t1 en formato long
 Dim DifT            ' Time actual - Time en punto 0 en formato time
 Dim sDifT As String ' DifT en formato String
 Dim lDift As Long   ' DifT en segundos
 Dim lHor As Long    ' nAuto en formato HHMMSS
 Dim sHor As String  ' nAuto en formato string
 
 On Error Resume Next
 
 
 ' Filtro. Punto 0

 If iAuto = 0 Then Exit Sub
 
 
 ' Contador y reloj
 
 nAuto = nAuto + 1
 
 t = Time          ' Time actual
 st = t            ' En formato HH:MM:SS alfanumerico
 lt = F_TimeS(st)  ' En formato HHMMSS long
 
 t1 = t + TimeValue("00:00:01") ' Time + 1 segundo
 st1 = t1                       ' En formato HH:MM:SS
 lt1 = F_TimeS(st1)             ' En formato HHMMSS long
 
 
 ' Pasa contador y reloj
 
 Range("A1") = Date
 Range("B1") = t
 
 
 ' Dif.temporal entre times reales
 
 DifT = t - t0
 
 
 ' Segundos asociados a la dif.temporal entre times reales
 
 sDifT = F_DifTime(lt0, lt)

 
 
 ' Pasa dif.temporal
 
 Range("C1") = DifT
 Range("D1") = sDifT
 

 
 ' Auto_invocación en el próximo segundo
 
 Application.OnTime t1, "Hoja1.Reloj_Macro"


End
Sub


                                                                                                ________


El código fuente completo completo se encuentra en el módulo F que se integra en la hoja de muestra PruebaOnTime

                                                                                                ________