¿Cómo abrir un libro utilizando casillas de verificación para la ubicación y nombre en la hoja de calculo, mediante una macro?
Se podría realizar una condición con una casilla de verificación, ya que deseo abrir varios archivos, hay ocasiones en las que solamente necesito tres archivos y otras veces necesito seis. Que al seleccionar la casilla de verificación abra solamente los seleccionados.
Con la siguiente macro puedes abrir los libros según la casilla.
Tienes que indicarle en la macro, para cada casilla (Check box), en qué fila se encuentra la ruta y nombre del archivo, en la macro va como ejemplo que la casilla1 la fila de su archivo está en la fila 2, y así para cada casilla tienes que poner el número de fila.
Sub objeto() 'Por.DAM Set l1 = ThisWorkbook On Error Resume Next For Each obj In ActiveSheet.DrawingObjects nombre = obj.Name Select Case nombre Case "Check Box 1": fila = 2 Case "Check Box 2": fila = 3 Case "Check Box 3": fila = 4 End Select If obj.Value = 1 Then Workbooks.Open Cells(fila, "B") & Cells(fila, "C") l1.Activate End If Next End Sub
Prueba y me comentas
1 respuesta más de otro experto
Supondré que las casillas de verificación están en la columna A, la Ruta la columna B y el archivo en la columna C
La primera fila será la segunda y que los Checkbox se llamen Checkbox1, Checkbox2, etc, donde
Checkbox1 corresponde a la fila 2
Checkbox2 corresponde a la fila 3
Etc.
Pues después de varias horas me ha resultado imposible hacer una macro que sirva para un número indeterminado de objetos, asi que habrá que hacer una que sirva para un número limitado 10 por ejemplo, si se quieren más ficheros se puede ampliar la macro a base de copiar pegar y modificar.
Hay otra solución solo que es más incomoda para ti, que sería cada vez que creas un checkbox asociarlo a una celda, eso se hace en la propiedad linkedcell en tiempo de diseño. Así si que se podría hacer para cualquier número de ficheros. La celda que se asociaria sería la de la columna A que está en la fila del chekbox.
Primero la macro sin que asocies las celdas pero limitada a 10 ficheros (o los que quieras añadir en el código con trabajo) es
Sub AbrirSeleccionados()
Dim chks As OLEObject
On Error GoTo NoSePudo
Application.ScreenUpdating = False
For Each chks In ActiveSheet.OLEObjects
If chks.Name = "CheckBox1" Then
If ActiveSheet.CheckBox1 Then Workbooks.Open (Cells(2, "B") & Cells(2, "C"))
ElseIf chks.Name = "CheckBox2" Then
If ActiveSheet.CheckBox2 Then Workbooks.Open (Cells(3, "B") & Cells(3, "C"))
ElseIf chks.Name = "CheckBox3" Then
If ActiveSheet.CheckBox3 Then Workbooks.Open (Cells(4, "B") & Cells(4, "C"))
ElseIf chks.Name = "CheckBox4" Then
If ActiveSheet.CheckBox4 Then Workbooks.Open (Cells(5, "B") & Cells(5, "C"))
ElseIf chks.Name = "CheckBox5" Then
If ActiveSheet.CheckBox5 Then Workbooks.Open (Cells(6, "B") & Cells(6, "C"))
ElseIf chks.Name = "CheckBox6" Then
If ActiveSheet.CheckBox6 Then Workbooks.Open (Cells(7, "B") & Cells(7, "C"))
ElseIf chks.Name = "CheckBox7" Then
If ActiveSheet.CheckBox7 Then Workbooks.Open (Cells(8, "B") & Cells(8, "C"))
ElseIf chks.Name = "CheckBox8" Then
If ActiveSheet.CheckBox8 Then Workbooks.Open (Cells(9, "B") & Cells(9, "C"))
ElseIf chks.Name = "CheckBox9" Then
If ActiveSheet.CheckBox9 Then Workbooks.Open (Cells(10, "B") & Cells(10, "C"))
ElseIf chks.Name = "CheckBox10" Then
If ActiveSheet.CheckBox10 Then Workbooks.Open (Cells(11, "B") & Cells(11, "C"))
End If
ThisWorkbook.Activate
Next
On Error GoTo 0
Application.ScreenUpdating = True
MsgBox ("Macro finalizada, mire a ver si abrieron los ficheros")
Exit Sub
NoSePudo:
MsgBox "Ha habido algún error, pulse para continuar"
Resume Next
End SubTe mando esto de momento, luego mandaré la macro que funciona si asocias los checkbos a celdas con la propiedad linkedcell en tiempo de diseño.
Y esta es la que te decía, imprescindible poner la propiedad LinkedCell y asegurate que todas las celdas de la columna A a partir de la 2 tienen el valor verdadero o falso. Puedes reducir el ancho para que no se vea, pero asegurate que tienen valor.
Sub AbrirSeleccionadosLinked()
Dim i, FilaFinal As Integer
Dim NombreYRuta As String
Application.ScreenUpdating = False
FilaFinal = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To FilaFinal
If LCase(Cells(i, "A")) = "verdadero" Then
NombreYRuta = Cells(i, "B") & Cells(i, "C")
On Error GoTo NoSePudo
Workbooks.Open (NombreYRuta)
ThisWorkbook.Activate
On Error GoTo 0
End If
Next
Application.ScreenUpdating = True
MsgBox ("Macro finalizada, mire a ver si abrieron los ficheros")
Exit Sub
NoSePudo:
MsgBox "No se pudo abrir " & NombreYRuta, vbCritical
Resume Next
End SubY eso es todo.
Ya he dado con la macro perfecta, está basada en la respuesta que te dio Dante a la que he añadido alguna mejora y mi forma de programar.
Sub AbrirDefinitiva() 'Por.DAM y ValeroASM Application.ScreenUpdating = False On Error GoTo NoSePudo For Each obj In ActiveSheet.DrawingObjects If TypeName(obj) = "CheckBox" Then fila = Val(Mid(obj.Name, 11)) + 1 If obj.Value = 1 Then Workbooks.Open Cells(fila, "B") & Cells(fila, "C") ThisWorkbook.Activate End If End If Next Application.ScreenUpdating = True Exit Sub NoSePudo: MsgBox "Hubo un error en la fila " & fila, vbInformation Resume Next End Sub
Asimismo, te pido en mi nombre que puntúes con excelente la respuesta que te dio Dante Amor, ya que es muy buena y sin ella me hubiera sido imposible darte esta que te doy ahora que no tiene ninguna limitación en cuanto a número de ficheros y no tienes que enlazar los checbox con las filas.
Muchos saludos.