Pegar Vínculos
Que tal Fernando!
Estoy trabajando en una macro que me identifica celdas que tienen vínculos a otros libros.
La macro de este libro busca en un rango seleccionado, las celdas que tienen un vínculo a otra hoja, a través del parámetro "[" (ya que cuando se vincula una celda a otra celda de otro libro, excel utiliza este carácter.) Copia las celdas que tienen vínculos, y las va pegando una debajo de otra como vinculo, en una hoja que se llama "Excepciones", de forma que a través de la barra de fórmulas podemos ver en que celda se encuentra el vínculo
La macro tiene el siguiente código:
Sub ENCONTRARVINCULOS()
Application.ScreenUpdating = False
With Selection
Set c = .Find("[", LookIn:=xlFormulas)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Copy
Sheets("Excepciones").Select
Range("A65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1,0).Range("A1").Select
ActiveSheet.Paste Link:=True
Application.CutCopyMode = false
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Sheets("Excepciones").Select
Range("A1").Select
End Sub
La macro funciona muy bien; No obstante lo que me gustaría hacer es que cuando se encuentren las excepciones y se peguen a la hoja de excepciones creada, se hagan como un hipervínculo, de forma que pinchando directamente sobre la celda se vaya a la dirección deseada.
¿Sabes si es posible hacer esto? (No se si me he explicado muy bien)
Muchísimas gracias
Un abrazo
Nacho.
Estoy trabajando en una macro que me identifica celdas que tienen vínculos a otros libros.
La macro de este libro busca en un rango seleccionado, las celdas que tienen un vínculo a otra hoja, a través del parámetro "[" (ya que cuando se vincula una celda a otra celda de otro libro, excel utiliza este carácter.) Copia las celdas que tienen vínculos, y las va pegando una debajo de otra como vinculo, en una hoja que se llama "Excepciones", de forma que a través de la barra de fórmulas podemos ver en que celda se encuentra el vínculo
La macro tiene el siguiente código:
Sub ENCONTRARVINCULOS()
Application.ScreenUpdating = False
With Selection
Set c = .Find("[", LookIn:=xlFormulas)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Copy
Sheets("Excepciones").Select
Range("A65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1,0).Range("A1").Select
ActiveSheet.Paste Link:=True
Application.CutCopyMode = false
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Sheets("Excepciones").Select
Range("A1").Select
End Sub
La macro funciona muy bien; No obstante lo que me gustaría hacer es que cuando se encuentren las excepciones y se peguen a la hoja de excepciones creada, se hagan como un hipervínculo, de forma que pinchando directamente sobre la celda se vaya a la dirección deseada.
¿Sabes si es posible hacer esto? (No se si me he explicado muy bien)
Muchísimas gracias
Un abrazo
Nacho.
1 Respuesta
Respuesta de fejoal
1
Entendí que donde se pegue la referencia a la celda debería haber un vínculo que abra el archivo asociado a esa excepción.
Si esto es correcto, agrega a tu macro estas líneas de código.
a.- después de Do
Hlink = c.Formula
fromC = InStr(1, Hlink, "C:", 1)
ToRem = InStr(1, Hlink, "[", 1)
ToXLS = InStr(1, Hlink, "XLS", 1)
Hlink = Mid(Hlink, fromC, ToRem - fromC) & Mid(Hlink, ToRem + 1, ToXLS - ToRem + 2)
' esto deja en la variable Hlink la dirección del archivo que tomó de la celda antes de copiarla.
----
b.- y después de
ActiveSheet.Paste Link:=True
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Hlink
'Aplica a esta misma celda un hiperlink a la dirección cargada en Hlink
---
Hasta donde probé, esto funcionó bien.
La única condición es que el archivo vinculado no esté abierto al momento de ejecutar la macro.
Pruébalo, dime y finaliza esta pregunta, si todo está bien.
Un abrazo!
Fernando
Si esto es correcto, agrega a tu macro estas líneas de código.
a.- después de Do
Hlink = c.Formula
fromC = InStr(1, Hlink, "C:", 1)
ToRem = InStr(1, Hlink, "[", 1)
ToXLS = InStr(1, Hlink, "XLS", 1)
Hlink = Mid(Hlink, fromC, ToRem - fromC) & Mid(Hlink, ToRem + 1, ToXLS - ToRem + 2)
' esto deja en la variable Hlink la dirección del archivo que tomó de la celda antes de copiarla.
----
b.- y después de
ActiveSheet.Paste Link:=True
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Hlink
'Aplica a esta misma celda un hiperlink a la dirección cargada en Hlink
---
Hasta donde probé, esto funcionó bien.
La única condición es que el archivo vinculado no esté abierto al momento de ejecutar la macro.
Pruébalo, dime y finaliza esta pregunta, si todo está bien.
Un abrazo!
Fernando
Muchas Gracias Fernando; Va muy bien y efectivamente el libro vinculado tiene que estar cerrado. No obstante lo que yo busco, es simplemente que me pegue como hipervínculo en la hoja de excepciones la referencia a la celda que tiene el vinculo; Ejemplo:
Libro: "libro1"
Hojas: "Excepciones";"Hoja1"
En la "hoja1" hay celdas (Por ejemplo "A1") que contienen vínculos a otro libro; Por ejemplo "Librovinculado.xls"
Lo que busco es que al ejecutar la macro en la hoja "Excepciones" Se me pegue la celda de la "Hoja1" que contiene vínculos de forma que me aparece "=hoja1!A1" (esto ya lo consigo) y simplemente, lo que quiero es que en esa hoja de excepciones se me pegue como hypervinculo (no como simple vinculo) "Hoja1!A1(subrayado)" (No quiero ir al libro vinculado, sino a la celda que contiene el vinculo en el propio libro)
No se si me explicado bien,
Muchísimas gracias por tu paciencia.
Saludos
Libro: "libro1"
Hojas: "Excepciones";"Hoja1"
En la "hoja1" hay celdas (Por ejemplo "A1") que contienen vínculos a otro libro; Por ejemplo "Librovinculado.xls"
Lo que busco es que al ejecutar la macro en la hoja "Excepciones" Se me pegue la celda de la "Hoja1" que contiene vínculos de forma que me aparece "=hoja1!A1" (esto ya lo consigo) y simplemente, lo que quiero es que en esa hoja de excepciones se me pegue como hypervinculo (no como simple vinculo) "Hoja1!A1(subrayado)" (No quiero ir al libro vinculado, sino a la celda que contiene el vinculo en el propio libro)
No se si me explicado bien,
Muchísimas gracias por tu paciencia.
Saludos
Era más sencillo que lo que pensaba. No obstante la idea será la misma.
Agrega a tu macro estas líneas de código:
a.- después de Do
LLink = ActiveSheet.Name
LLink = "'"&LLink & "'!" & c.Address(False , False)
----
b.- y después de
ActiveSheet.Paste Link:=True
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=LLink
Range("B6").Select
Ahora, al hacer click en esa celda -subrayada- te llevará a la celda de donde toma los datos del archivo vinculado (pero sin abrir este).
Prueba y dime.
Agrega a tu macro estas líneas de código:
a.- después de Do
LLink = ActiveSheet.Name
LLink = "'"&LLink & "'!" & c.Address(False , False)
----
b.- y después de
ActiveSheet.Paste Link:=True
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=LLink
Range("B6").Select
Ahora, al hacer click en esa celda -subrayada- te llevará a la celda de donde toma los datos del archivo vinculado (pero sin abrir este).
Prueba y dime.
Muchas gracias fernando, funciona bien, no obstante solamente para la primera referencia; Si existen varias celdas seleccionadas, con vínculos no funciona, y no entiendo porque.
Prueba Tu, La Macro, según tus instrucciones queda tal que así:
Sub ENCONTRARVINCULOS()
Application.ScreenUpdating = False
With Selection
Set c = .Find("[", LookIn:=xlFormulas)
If Not c Is Nothing Then
firstAddress = c.Address
Do
LLink = ActiveSheet.Name
LLink = "'" & LLink & "'!" & c.Address(False, False)
c.Copy
Sheets("Excepciones").Select
Range("A65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste link:=True
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=LLink
Application.CutCopyMode = False
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Sheets("Excepciones").Select
Range("A1").Select
End Sub
Muchas gracias de nuevo
Prueba Tu, La Macro, según tus instrucciones queda tal que así:
Sub ENCONTRARVINCULOS()
Application.ScreenUpdating = False
With Selection
Set c = .Find("[", LookIn:=xlFormulas)
If Not c Is Nothing Then
firstAddress = c.Address
Do
LLink = ActiveSheet.Name
LLink = "'" & LLink & "'!" & c.Address(False, False)
c.Copy
Sheets("Excepciones").Select
Range("A65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste link:=True
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=LLink
Application.CutCopyMode = False
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Sheets("Excepciones").Select
Range("A1").Select
End Sub
Muchas gracias de nuevo
El problema es que la inicialización de la variable
LLink = ActiveSheet.Name
Toma el nombre de la hoja activa dentro del loop.
A simple vista me parece que te está faltando una vuelta a la hoja inicial después de pegar el vínculo y el hipervínculo.
Entonces, saca del loop Do tal inicialización y ponla después de
If Not c Is Nothing Then
Cambiándole el nombre (LLinkS)
Y usando este dentro del loop para que tome el nombre de la hoja.
Más fácil, reemplaza tu código por este, que es muy similar.
Sub ENCONTRARVINCULOS()
Application.ScreenUpdating = False
With Selection
Set c = .Find("[", LookIn:=xlFormulas)
If Not c Is Nothing Then
LLinkS = ActiveSheet.Name
firstAddress = c.Address
Do
LLink = "'" & LLinkS & "'!" & c.Address(False, False)
c.Copy
Sheets("Excepciones").Select
Range("A65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1).Select
ActiveSheet.Paste link:=True
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=LLink
Application.CutCopyMode = False
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Sheets("Excepciones").Select
Range("A1").Select
End Sub
Lo probé y funciona bien, pero fíjate de todos modos.
Un abrazo!
Fernando
LLink = ActiveSheet.Name
Toma el nombre de la hoja activa dentro del loop.
A simple vista me parece que te está faltando una vuelta a la hoja inicial después de pegar el vínculo y el hipervínculo.
Entonces, saca del loop Do tal inicialización y ponla después de
If Not c Is Nothing Then
Cambiándole el nombre (LLinkS)
Y usando este dentro del loop para que tome el nombre de la hoja.
Más fácil, reemplaza tu código por este, que es muy similar.
Sub ENCONTRARVINCULOS()
Application.ScreenUpdating = False
With Selection
Set c = .Find("[", LookIn:=xlFormulas)
If Not c Is Nothing Then
LLinkS = ActiveSheet.Name
firstAddress = c.Address
Do
LLink = "'" & LLinkS & "'!" & c.Address(False, False)
c.Copy
Sheets("Excepciones").Select
Range("A65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1).Select
ActiveSheet.Paste link:=True
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=LLink
Application.CutCopyMode = False
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Sheets("Excepciones").Select
Range("A1").Select
End Sub
Lo probé y funciona bien, pero fíjate de todos modos.
Un abrazo!
Fernando
Muchísimas gracias Fernando; Funciona perfectamente. Eres un genio! ; No sabes lo que me has ayudado. Gracias por tu ayuda, comprensión y paciencia.
Un abrazo
Nacho
Un abrazo
Nacho
