Macro que calcule las horas de apertura de un archivo

Hola de nuevo, no sé si es posible pero necesito crear una macro que después de 30 horas (por ejemplo) de uso del archivo excel no se pueda abrir, como una versión demo. La idea global es que pida una contraseña y que vuelva a poner el contador de horas a 0. Gracias.

1 Respuesta

Respuesta
1
Acá tienes :
Inserta esto en un modulo
Option Explicit
Dim h As Variant
Dim c As Boolean
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If c = True Then Exit Sub
    Hoja1.Range("iv65535") = Time
    Hoja1.Range("iu65536") = Hoja1.Range("iu65536") + Replace(Mid(CDate(Hoja1.Range("iv65536")), 1, 2), ":", "")
   ActiveWorkbook.Save
End Sub
Private Sub Workbook_Open()
Application.Goto Reference:="R1C1"
Application.ScreenUpdating = False
    If Hoja1.Range("iv65534") = Empty Then
        Hoja1.Range("iv65534", "iv65536").Select
        Selection.NumberFormat = "[$-F400]h:mm:ss AM/PM"
        Hoja1.Range("iv65534") = Time
        Hoja1.Range("IU65534:IV65536").Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    End If
    Hoja1.Range("iv65536").Formula = "=+R[-1]C-R[-2]C"
    If Hoja1.Range("iu65536") >= 30 Then
        h = InputBox("Reiniciar contador", "Demo")
        If Len(Trim(h)) = 0 Then c = True: ActiveWorkbook.Save: ActiveWorkbook.Close
        If h = 1234 Then
            c = False
            Hoja1.Range("iu65534", "iv65536").Clear
        Else
            c = True
            ActiveWorkbook.Save
            ActiveWorkbook.Close
        End If
    End If
Application.ScreenUpdating = True
Application.Goto Reference:="R1C1"
End Sub
Pruébalo y me comentas cualquier problema
Hola, el módulo me da error en xlthemecolordark1 (variable no definida), si lo elimino en la celda iv65534 me sale la hora en que lo abrí por primera vez, en iv65536 me sale un numero negativo -0,85 y en iv65535 está en blanco, ¿no debería aparecer la hora actual para calcular la diferencia? En iu no aparece nada. Perdona, soy una negada y no sé como solucionarlo. Perdona de nuevo y gracias por tu paciencia.
Esto lo escribí en version 2007, si tienes la misma no veo por que te de problemas, el color del font para el formato de las celdas, igual lo puedes obviar.
En la celda iv65534 efectivamente figura la hora de la primera apertura, y al cerrar el libro el macro pondrá en la celda iv65535 la hora en que lo cerraste, teniendo en iv65536 la fórmula
=+IV65535-IV65534
Acumulando las horas en celda iu65536
Como pediste para 30 horas le puse ese valor al
   If Hoja1.Range("iu65536") >= 30 Then
Pero para efectos de comprobación modifícalo por un valor más bajo, el password para reiniciar el contador es 1234
si continua el problema, te envío la planilla de prueba ( excel v2007)
Seguro que es una tontería pero no hay forma, ¿me puedes enviar la planilla de prueba para ver que estoy haciendo mal? Gracias.
¿Y el mail?
Perdona, pensé que accedías a mi perfil.
(xxxxxx)
Enviado.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas