Buenos días y gracias de antemano. Me estoy devanando los sesos y no consigo lo que necesito, que no es sino lo siguente:

Tengo dos libros de excel, cada uno de ellos, en un directorio diferente de una red. A saber:

H:\PROFESORES\ESTUDIOS\03_GESTION IPA\CURSO 2014_2015\DATOS\CUARTO\1CTR\RESUMEN.xls

H:\PROFESORES\ESTUDIOS\03_GESTION IPA\CURSO 2014_2015\DATOS\FECHAS LIMITE.xls

En la celda B5 DE FECHAS LIMITE.XLS pongo la fecha tope a partir de la que ya no se permitirá a los usuarios hacer uso del libro RESUMEN.xls.

La idea es que cuando se abra la hoja"RESUMEN" del libro RESUMEN.xls, el procedimiento Sub auto_open() lo primero que haga es comprobar la fecha actual del sistema con la que hay en la celda B5 de la hoja "Hoja1" del libro FECHAS LIMITE.XLS y que, mientras la fecha actual del sistema sea superior a la de la celda B5 aludida, muestre el userform Acceso.Show y en caso contrario que ejecute la funcion Sub Fechas_En_Letras() que pongo más abajo.

Como se puede ver lo he intentado pero he tenido que anular las filas usando ' porque me daban error. Lo siento pero no consigo hacerme con esto del VBA y por eso solicito vuestra ayuda, porque a lo mejor es más sencillo de lo que yo estoy tratando hacer. Salu2 y de nuevo gracias.

Sub auto_open()

Dim archivo As String

Dim carpeta As String

Dim r As Range

Dim i As Integer

Application.ScreenUpdating = False

Sheets(1).Visible = True

For i = 2 To Sheets.Count

Sheets(i).Visible = xlVeryHidden

Sheets(i).Protect "Miabuela1903"

ActiveWindow.DisplayWorkbookTabs = False

Next i

Sheets("RESUMEN").Protect "Miabuela1903"

Sheets("Clavesprof").Unprotect "Miabuela1903"

ActiveWindow.DisplayWorkbookTabs = False

Application.ScreenUpdating = True

'carpeta = "H:\PROFESORES\ESTUDIOS\03_GESTION IPA\CURSO 2014_2015\DATOS\"

'ChDir carpeta

'archivo = ("FECHAS LIMITE.xls")

' Workbooks.Open carpeta & archivo

'MsgBox ThisWorkbook

'If activWorkbook.Sheets("Hoja1").Range("B5") <> Date Then

'If ThisWorkbook.Sheets("Hoja1").Range("B5") <> Date Then 'Or _

'ThisWorkbook.Sheets("Hoja1").Range("B5") = "" Then

If Range("O2").Value = "" Then

Acceso.Show

Else

Fechas_En_Letras

End If

End Sub

Sub Fechas_En_Letras()

'ndia es el día de la semana que va desde 1 hasta 7.

ndia = Weekday((Range("O2").Value))

'numes es el número del mes que va desde 1 hasta 12.

nummes = Month((Range("O2").Value))

'diames es el día del mes que va desde 1 hasta 31.

diames = Day((Range("O2").Value))

'año es, evidentemente, el año de la fecha.

año = Year((Range("O2").Value))

Select Case nummes

Case 1

mes = "Enero"

Case 2

mes = "Febrero"

Case 3

mes = "Marzo"

Case 4

mes = "Abril"

Case 5

mes = "Mayo"

Case 6

mes = "Junio"

Case 7

mes = "Julio"

Case 8

mes = "Agosto"

Case 9

mes = "Septiembre"

Case 10

mes = "Octubre"

Case 11

mes = "Noviembre"

Case 12

mes = "Diciembre"

End Select

Select Case ndia

Case 1

dia = "Domingo"

Case 2

dia = "Lunes"

Case 3

dia = "Martes"

Case 4

dia = "Miercoles"

Case 5

dia = "Jueves"

Case 6

dia = "Viernes"

Case 7

dia = "Sabado"

End Select

MsgBox "Usted tenía hasta el " & dia & " " & diames & " de " & mes & " de " & año & " para calificar." & vbCrLf & _

vbCrLf & "Ahora ya no puede introducir datos.", vbCritical, "CALIFICACIÓN IPAs"

End Sub

Bueno a veces las hojas de los árboles no te dejan ver el bosque. Me contesto yo mismo. Se me ha encendido la luz y con este código me funciona, aunque seguramente los expertos lo harían de forma más eficaz. Gracias de todas formas. Lo pongo por si a alguien le sirve:

Sub auto_open()

Dim archivo As String

Dim carpeta As String

Dim r As Range

Dim i As Integer

Application.ScreenUpdating = False

Sheets(1).Visible = True

For i = 2 To Sheets.Count

Sheets(i).Visible = xlVeryHidden

Sheets(i).Protect "Miabuela1903"

ActiveWindow.DisplayWorkbookTabs = False

Next i

Sheets("RESUMEN").Protect "Miabuela1903"

Sheets("Clavesprof").Unprotect "Miabuela1903"

ActiveWindow.DisplayWorkbookTabs = False

carpeta = "H:\PROFESORES\ESTUDIOS\03_GESTION IPA\CURSO 2014_2015\DATOS\"

ChDir carpeta

archivo = ("FECHAS LIMITE.xls")

Workbooks.Open carpeta & archivo

If ActiveWorkbook.Sheets("Hoja1").Range("B5") >= Date _

Or ActiveWorkbook.Sheets("Hoja1").Range("B5") = "" Then

ActiveWorkbook.Close

ActiveWorkbook.Save

ThisWorkbook.Activate

Acceso.Show

Else

ActiveWorkbook.Close

ActiveWorkbook.Save

ThisWorkbook.Activate

Fechas_En_Letras

End If

Application.ScreenUpdating = True

End Sub