Abrir otros archivos, coger información y cerrar.

[ssanceb]

Buenas a todos, acudo a su ayuda para intentar terminar una macro en la que llevo comiéndome la cabeza bastante tiempo.

Resumiendo, lo que intento es hacer una hoja de firmas de profesores, en la que según los horarios de cada profesor, donde tienen clase o alguna actividad la casilla quede en blanco con la intención de que firmen y donde en su horario no tengan clase pues aparezca una X para no firmar.

Por tanto, la planilla sería diaria, para firmar cada día de la semana, de manera que según el día seleccionado en la lista desplegable de la hoja "HOJA" del Archivo principal "MACRO FIRMAS", la macro abra los archivos de los horarios de los profesores, que se encuentran numerados (en este caso a modo de ejemplo he puesto 3) y que se encuentran en la misma carpeta, y coloque las X correspondientes en las horas de dicho día.

Por si a alguien le sirve para ayudarme, tengo la misma macro en openoffice y funciona correctamente, aunque como sabéis el código es distinto.

En excel hay alguna parte de la macro que tengo mal programada y no consigo arreglar, ya que al ejecutarla no hace nada.

Agradecería cualquier ayuda posible. Subo archivos que espero sirvan de más ayuda que la explicación.

Un saludo y muchas gracias de antemano.

FIRMAS.rar

[ssanceb]

Subo el código por si alguien al leerlo me puede decir algún fallo:

Cita

Sub Firmas()

'******************** DEFINIR VARIABLES

Dim LIBRO As Object
Dim HOJA As Object
Dim IMPRESION As Object
Dim PRINCIPAL As Object
Dim PROFESORADO As Object

Dim HORARIO As Object
Dim HOJA_HORARIO As Object

Dim k As Integer
Dim c As Integer
Dim DIA As Integer
 
Set LIBRO = ThisWorkbook
Set HOJA = LIBRO.Sheets("HOJA")
Set IMPRESION = LIBRO.Sheets("IMPRESIÓN")
Set PROFESORADO = LIBRO.Sheets("PROFESORADO")

'***********************Borrado de celdas

HOJA.Range("C8:K80").ClearContents

'***********************Número de día

If ActiveSheet.Range("M9").Value = "LUNES" Then
DIA = 1

ElseIf ActiveSheet.Range("M9").Value = "MARTES" Then
DIA = 2

ElseIf ActiveSheet.Range("M9").Value = "MIÉRCOLES" Then
DIA = 3

ElseIf ActiveSheet.Range("M9").Value = "JUEVES" Then
DIA = 4

ElseIf ActiveSheet.Range("M9").Value = "VIERNES" Then
DIA = 5

'***********************ABRIR HORARIOS

c = PROFESORADO.Range("C5").Value

For k = 1 To c

Set ruta = LIBRO.Path

Set Rutalocal = ruta & "\" & PROFESORADO.Range(k + 7, 3).Value & ".xls*"

Set HORARIO = Workbooks.Open(Rutalocal)
Set HOJA_HORARIO = HORARIO.Worksheets("Hoja1")

For i = 1 To 8

If HOJA_HORARIO.Range(i, DIA).String = "*" Then
HOJA.Range(6 + k, 1 + i).String = "X"

Else
HOJA.Range(6 + k, 1 + i).String = ""

End If

Next

HORARIO.Close

Next

End If
MsgBox ("TERMINADO")

End Sub

y el archivo en formato excel 2003 ya que el anterior archivo estaba en 2013.

Muchísimas gracias de nuevo y espero cualquier ayuda posible.

Un saludo.

Firmas Web.zip

[Max2005]

Hola @ssanceb, 

He revisado tu Macro y realice una modificación, ¿podrías revisar e indicar si ya esta funcionando?

Sub Firmas()

'******************** DEFINIR VARIABLES

Dim LIBRO As Object
Dim HOJA As Object
Dim IMPRESION As Object
Dim PRINCIPAL As Object
Dim PROFESORADO As Object

Dim HORARIO As Object
Dim HOJA_HORARIO As Object


Dim k As Integer
Dim c As Integer
Dim DIA As Integer
 
'DIM mArg(0) As New

Set LIBRO = ThisWorkbook
Set HOJA = LIBRO.Sheets("HOJA")
Set IMPRESION = LIBRO.Sheets("IMPRESIÓN")
Set PROFESORADO = LIBRO.Sheets("PROFESORADO")

'***********************Borrado de celdas

HOJA.Range("C8:K80").ClearContents


'***********************Número de día

If ActiveSheet.Range("M9").Value = "LUNES" Then DIA = 1
If ActiveSheet.Range("M9").Value = "MARTES" Then DIA = 2
If ActiveSheet.Range("M9").Value = "MIÉRCOLES" Then DIA = 3
If ActiveSheet.Range("M9").Value = "JUEVES" Then DIA = 4
If ActiveSheet.Range("M9").Value = "VIERNES" Then DIA = 5

'***********************ABRIR HORARIOS

c = PROFESORADO.Range("C5").Value


For k = 1 To c


Set ruta = LIBRO.Path

Set Rutalocal = ruta & "\" & PROFESORADO.Range(k + 7, 3).Value & ".xls*"


Set HORARIO = Workbooks.Open(Rutalocal)
Set HOJA_HORARIO = HORARIO.Worksheets("Hoja1")


For i = 1 To 8

If HOJA_HORARIO.Range(i, DIA).String = 1 Then
HOJA.Range(6 + k, 1 + i).String = "X"

Else
HOJA.Range(6 + k, 1 + i).String = ""

End If

Next

HORARIO.Close

Next

MsgBox ("TERMINADO")


End Sub

Mucha Suerte !!!

Saludos 

[ssanceb]

Hola @Max2005, en primer lugar muchas gracias de antemano.

He copiado el código y me dice al ejecutar la macro "se ha producido el error 13 en tiempo de ejecución: no coinciden los tipos" y al darle a depurar me señala la frase Set ruta=LIBRO.Path.

Bueno cualquier tipo de idea que tengas y puedas aportarme de veras que te la agradezco.

Muchísimas gracias.

Un saludo.

[ssanceb]

¿Alguien se le ocurre algo?

 

Gracias de nuevo.