............ Foro Excel
Si no lo has hecho aún: REGISTRATE!!!

CADUCA Y VUELVETE UN ARCHIVO SOLO DE LECTURA!...

Ver el tema anterior Ver el tema siguiente Ir abajo

CADUCA Y VUELVETE UN ARCHIVO SOLO DE LECTURA!...

Mensaje por gusmario2011 el Vie Nov 25, 2011 10:37 pm

CADUCA Y VUELVETE UN ARCHIVO SOLO DE LECTURA!...

Hola, navegando en la web encontre una paguina en ingles con otro codigo interesante, que hace que el archivo caduque al cierto tiempo y ademas vuelve al archivo solo como de lectura, prohibe el guardar los cambios en el archivo temporal...

espero les interese.

Código:
Private Sub workbook_open()
Call MakeReadOnly
End Sub

Sub MakeReadOnly()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' MakeReadOnly
' This procedure uses a defined name to store the expiration
' date and if the workbook has expired, makes the workbook
' read-only.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim ExpirationDate As String
Dim NameExists As Boolean

On Error Resume Next
ExpirationDate = Mid(ThisWorkbook.Names("ExpirationDate").Value, 2)
If Err.Number <> 0 Then
    '''''''''''''''''''''''''''''''''''''''''''
    ' Name doesn't exist. Create it.
    '''''''''''''''''''''''''''''''''''''''''''
    ExpirationDate = CStr(DateSerial(Year(Now), _
        Month(Now), Day(Now) + C_NUM_DAYS_UNTIL_EXPIRATION))
    ThisWorkbook.Names.Add Name:="ExpirationDate", _
        RefersTo:=Format(ExpirationDate, "short date"), _
        Visible:=False
    NameExists = False
Else
    NameExists = True
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If the today is past the expiration date, make the
' workbook read only. We need to Save the workbook
' to keep the newly created name intact.
''''''''''''''''''''''''''''''''''''''''''''''''''''''
If CDate(Now) >= CDate(ExpirationDate) Then
    If NameExists = False Then
        ThisWorkbook.Save
    End If
    ThisWorkbook.ChangeFileAccess xlReadOnly
End If

End Sub

gusmario2011

Masculino Cantidad de envíos : 9
Edad : 50
Ciudad - Pais : mexicali - mexico
Version de Excel : 2007
Fecha de inscripción : 20/11/2011

Volver arriba Ir abajo

Re: CADUCA Y VUELVETE UN ARCHIVO SOLO DE LECTURA!...

Mensaje por GalileoGali el Dom Nov 27, 2011 12:28 am

Este ultimo código sí, me satsiface. Gracias!!!!

_________________
GalileoGali
M.A.P. 2010-2013
Microsoft Active Professional
avatar
GalileoGali
Admin

Masculino Cantidad de envíos : 1963
Edad : 61
Ciudad - Pais : QUIROGA, Argentina
Version de Excel : 2000-2003-2007-2010
Fecha de inscripción : 24/01/2008

http://excelgali.mejorforo.net

Volver arriba Ir abajo

Ver el tema anterior Ver el tema siguiente Volver arriba


 
Permisos de este foro:
No puedes responder a temas en este foro.