Modificación de la macro de apertura de archivo Excel un determinado número de veces
Para Adriel Ortiz Mangia
Hola Adriel
He visto tu respuesta para la pregunta de este foro “Necesito que un archivo de excel se abra solo cierta cantidad de veces y después de esas veces te solicite una contraseña” y la estoy adaptando a mis necesidades. Esta macro NO me funciona bien si el archivo, como es mi caso, siempre lo abro como “solo lectura” (ya que somos varios usuarios los que lo utilizamos y lo gestiono yo). Había pensado (pero no sé cómo hacerlo) que fuera en otro segundo archivo que tengo SIEMPRE abierto el ponerle el contador del número de veces que se va abriendo mi archivo. Este segundo archivo está en un servidor y mi archivo está en el disco duro del PC que utilizamos. No sé si habrá problemas porque uno esté en el servidor y otro no por el tema de las rutas. Supongamos que mi archivo se llama “miarchivo.xlsm” y el otro archivo se llama ”otroarchivo.xls” .
Hola Adriel
Gracias por atenderme. Mi fichero está protegido por escritura, pero el otro fichero (que está en el servidor) no tiene contraseña, por eso quería poner el contador en este segundo fichero. ¿Me podrías echar una mano?. Gracias
Haber envíame tu archivo [email protected] y me explicas como deseas
Te envié un email espero tus comentarios
Hola Adriel, te mande un correo hace 3 días con una aclaración.
Un saludo Ruben
Lo reviso y te aviso saludos!
Te paso la macro
Libro2
Private Sub Workbook_Open()
Application.DisplayAlerts = False
Set h = Sheets("Hoja1")
h.Range("D10") = h.Range("D10") + 1
'
Select Case h.Range("D10").Value
Case 0 To 2
ThisWorkbook.Password = ""
''''''Call abre_libro 'ABRE EL LIBRO DEL SERVIDOR
Case 3
ThisWorkbook.Password = "isa" ' Clave
MsgBox "NO SE PUEDE ABRIR MAS VECES EL ARCHIVO PRODUCCION"
h.Range("D10").Value = 0
ThisWorkbook.Save
Application.Quit
End Select
ThisWorkbook.Save
End Subpara Producción
Private Sub Workbook_Open()
'**********************************************************************************
'[Por Adriel Ortiz
'
'Ruta = "\servidorx\docs\control\" ' Aqui actualiza la ruta de tu servidor donde tienes el archivo
Ruta = "C:\Users\RUBEN\Desktop\PRUEBA\" ' Aqui actualiza la ruta de tu servidor donde tienes el archivo
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Archivo = "Libro2.xlsm" ' nombre del archivo que tienes en el servidor
'
On Error Resume Next
If Dir(Ruta & Archivo) <> "" Then
Set l2 = Workbooks.Open(Ruta & Archivo)
clave = l2.Unprotect
'
If clave = "" Then
Application.Quit
Else
Set h2 = l2.Sheets("Hoja1")
valor = h2.Range("D10")
'
If valor = 3 And valor = 0 Then
Application.Quit
End If
End If
Else
MsgBox "No existe el archivo, verifica la ruta"
End If
l2.Close
ThisWorkbook.Save
Application.ScreenUpdating = True
End SubTe envié el archivo.
