Jump to content

Max2005

Members
  • Content Count

    202
  • Joined

  • Last visited

  • Days Won

    2

Posts posted by Max2005


  1. Hola Amigos ...

    Aquí les dejo este programa que solicita contraseña para iniciar de acuerdo a una fecha, el uso es muy sencillo para ingresar les dejo la contraseña en la hoja1, y esta fechado al 15 de septiembre de 2015 y lo único que hace es darte 2 avisos antes de borrar el archivo, se deberá de manejar precaución ya que si olvidan la contraseña se elimina el archivo ... :(

    La Macro se encuentra en "ThisWorkbook"

    Básicamente lo comparto para que exploren la programación, se que hay varias formas de hacer proteger datos pero esta se me hizo muy interesante y sobre todo espero les sea de utilidad.

    Saludos

    Max2005

    Contraseña de Ingreso.zip


  2. Hola a Todos

    En el foro nos pueden ayudar a resolver un tema; incluso, nos pueden dar muchas ideas; sin embargo, si utilizamos excel en nuestro trabajo diario, estamos OBLIGADOS a aprender, a estudiar, a investigar...

    [uSER=187503]@juan[/uSER] Reyes Martínez

    Ya eres todo un Capo en el Foro ya es tiempo de que nos demuestres que tanto has aprendido +++++ 10 10 10 ¿o No? ;)

    Saludos !!!


  3. [uSER=53155]@JoaoM[/uSER]

    Si introduces la contraseña, te deja entrar al archivo, si ves en la macro tienes 3 posibilidades para ingresarla ...

    YA mañana lo probare a ver si me lo borra.

    Tengo alguna que otra macro donde caduca por fecha pero no borra el archivo, solo dice que la fecha de validez caduco, contacte el administrador

    Saludos !!!


  4. Hola hector Arce,

    Esta puede ser otra alternativa

    Option Explicit
    Public fecAviso As Date
    Public fecBorra As Date
    Public fecLimit As Date
    Public avsUno, avsDos As String
    Public verErr As String
    Public licUso, licUs2, licUs3 As String
    Public Fin As String

    Private Sub Workbook_Open()

    fecAviso = DateSerial(2013, 4, 1)
    fecBorra = fecAviso + 2
    fecLimit = fecAviso + 1

    If Date <= fecAviso Then Exit Sub
    If Date = fecLimit Then GoTo avsUno
    If Date = fecBorra Then GoTo avsDos

    Application.EnableCancelKey = xlErrorHandler
    On Error GoTo verErr

    licUso = InputBox("INTRODUZCA LA LICENCIA DE USO, EL TIEMPO DE VIGENCIA SE HA CADUCADO", "LICIENCIA USO")
    If licUso <> "ABCD" Then
    MsgBox "Error de Contraseña, Intente de Nuevo"
    licUs2 = InputBox("INTRODUZCA LA LICENCIA DE USO, EL TIEMPO DE VIGENCIA SE HA CADUCADO", "LICIENCIA USO")
    If licUs2 <> "ABCD" Then
    MsgBox "Error de Contraseña, Intente de Nuevo"
    licUs3 = InputBox("INTRODUZCA LA LICENCIA DE USO, EL TIEMPO DE VIGENCIA SE HA CADUCADO", "LICIENCIA USO")
    If licUs3 <> "ABCD" Then
    MsgBox "Error de Contraseña, El Archivo se Borrara"
    Application.DisplayAlerts = False
    Me.ChangeFileAccess xlReadOnly
    Kill Me.FullName
    Me.Close False
    End If
    End If
    End If
    GoTo Fin

    'Gestion del primer aviso
    avsUno:
    Application.EnableCancelKey = xlErrorHandler
    On Error Resume Next
    MsgBox "Error de Contraseña ERROR GRAVE !!! El Archivo se Borrara", vbInformation
    Application.DisplayAlerts = False
    Me.ChangeFileAccess xlReadOnly
    ' Kill Me.FullName
    Me.Close False
    MsgBox "EL ARCHIVO SE BORRARA", vbCritical

    'Gestion del segundo aviso
    avsDos:
    Application.EnableCancelKey = xlErrorHandler
    On Error Resume Next
    MsgBox "Error de Contraseña ERROR GRAVE", vbCritical
    Application.DisplayAlerts = False
    Me.ChangeFileAccess xlReadOnly
    ' Kill Me.FullName
    Me.Close False
    MsgBox "EL ARCHIVO SE BORRARA", vbCritical

    'Gestion por Error
    verErr:
    ActiveWorkbook.Close

    Fin:
    End Sub
    [/CODE]

    Puse como texto lo de eliminar archivo para que no te vaya a borrar tu archivo, en fecAviso va la fecha que quieres como caducidad

    Mucha Suerte

    Saludos !!!


  5. Hola EDGAR S.H.

    Lo que pasa es que tienes el evento

    Private Sub Worksheet_SelectionChange(ByVal Target As Range), creo que por esta razón te hace el cambio hasta que seleccionas lo que cambiaste

    así también esto era lo que solicitabas en tu publicación anterior, quieres que funcionen 2 aplicaciones distintas con el evento

    Private Sub Worksheet_Change(ByVal Target As Range), yo creo que si es posible pero al menos me tomaría algo de tiempo poder ayudarte.

    Espero Te sea útil mi comentario

    Saludos !!!

×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png