Hipervínculo al guardar un libro en excel...¿? Duda
hola un saludo cordial a todo :
mi duda es la siguiente, tengo un formulario el cual se llama lista, el cual me genera otro excel aparte con un nombre que yo le asigno, en este formulario me da la opción de agregar un hipervínculo hacia un pdf o un word .el cual se me agrega en una celda que yo le asigno, el problema que tengo es que al momento de generer en el formulario un nuevo archivo excel por ej: prueba1,en este no me aparece el hipervínculo que aparece en la lista A, solo me aparece el dato sin el hipervínculo...
como puedo hacer para que me aparezca el hipervínculo en el archivo que genero...?''?
saludos y muchas gracias... :D
1 respuesta
mi amigo gracias por responder ahy te envíe el archivo a tu correo , ojala se pueda realizar
saludos y gracias
No te está poniendo el hipervínculo, porque en esa parte solamente estás pasando el valor del textbox a la celda, tienes que crear el hipervínculo en esta parte de la macro:
Private Sub CREAR_LISTA2()
Dim n As Integer
Dim wbNuevoLibro As Workbook
Dim nFilaSalida As Integer
Dim sFileXLS$
Dim ruta
Dim NIVEL_ant As Integer 'nivel de jerarquía del ítem inmediato anterior
Dim RAIZ_ant As String 'raíz o padre del ítem inmediato anterior
Dim J As Integer 'variable contador
'1. Comprobamos si hay algún elemento seleccionado en la lista
If Not ElementosSeleccionados() Then
MsgBox "Debes seleccionar algún elemento de la lista", vbInformation
Exit Sub
End If
'2. Abrimos un nuevo libro de trabajo excel
Set wbNuevoLibro = Workbooks.Add()
nFilaSalida = 7
wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 1) = "ITEM"
wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 2) = "DESCRIPCION"
wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 3) = "Estandar"
wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 4) = "UNIDAD"
wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 5) = "CANTIDAD."
wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 6) = "PRECIO UNITARIO $"
wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 7) = "PRECIO TOTAL $"
Columns("B:B").ColumnWidth = 81.57
Columns("D:D").ColumnWidth = 14.57
Columns("E:E").ColumnWidth = 19.86
Columns("F:F").ColumnWidth = 13.29
Columns("G:G").ColumnWidth = 13.99
nFilaSalida = nFilaSalida + 1
'Fecha
Range("F5").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("F5").Select
Selection.NumberFormat = "[$-340A]d"" de ""mmmm"" de ""yyyy;@"
Columns("F:F").ColumnWidth = 19.71
'3. Recorremos la lista de elementos y pasamos los seleccionados al nuevo libro
NIVEL_ant = -1
RAIZ_ant = ""
For n = 0 To LIS.ListCount - 1
If LIS.Selected(n) = True Then
'Re-enumerar los ítems, de modo que los de una misma jerarquía
'se enumeren consecutivamente, a partir del 1.
'Sólo aplica para objetos hijo, es decir, objetos con jerarquía mayor
'que cero.
If nFilaSalida > 7 Then
If NIVEL(LIS.List(n, 0)) > 0 Then
If raiz(LIS.List(n, 0)) = RAIZ_ant Then
J = J + 1
Else
J = 1
End If
Else
J = 0
End If
Else
J = 0
End If
'esto es para evitar que los "puntos" se vuelvan "comas"
With wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 1)
.NumberFormat = "@"
.HorizontalAlignment = xlRight
If J = 0 Then
.Value = CStr(LIS.List(n, 0))
Else
.Value = CStr(raiz(LIS.List(n, 0))) & "." & CStr(J)
End If
.Value = Replace(.Text, ",", ".")
If NIVEL(LIS.List(n, 0)) = 0 Then
'pone en negrilla los ítems de nivel jerárquico cero
.Font.Bold = True
.Offset(0, 1).Font.Bold = True
End If
End With
wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 2) = LIS.List(n, 1) '"ITEM"
wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 3) = LIS.List(n, 2) '"DESCRIPCION"
wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 4) = LIS.List(n, 3) '"Estandar"
'aquí agregar el hipervínculo
Set celda = wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 4)
With celda
.Value = nombre
carpeta = "C:\Users\Salexis\Desktop\Lista Modificada\Estandares\"
ActiveSheet.Hyperlinks.Add Anchor:=celda, _
Address:=carpeta & .Value & ".pdf", _
ScreenTip:="Abrir " & .Value ', TextToDisplay:=nombre
End With
Set celda = Nothing
wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 5) = LIS.List(n, 4) '"UNIDAD"
wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 6) = LIS.List(n, 5) '"CANTIDAD."
wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 7) = LIS.List(n, 6) '"PRECIO UNITARIO $"
wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 8) = LIS.List(n, 7) '"PRECIO TOTAL $"
nFilaSalida = nFilaSalida + 1
NIVEL_ant = NIVEL(LIS.List(n, 0))
RAIZ_ant = raiz(LIS.List(n, 0))
End If
Next
'pone líneas de cuadrícula
bordes nFilaSalida
'4. Guardamos el libro
sFileXLS = ThisWorkbook.Path & "\" & NOMBRE_DOCUMENTO & ".xlsx"
If Dir(sFileXLS) <> "" Then
'Comprobamos si el archivo ya existe, en este caso, lo borramos
Kill sFileXLS
End If
WbNuevoLibro. SaveAs sFileXLS
'5. Cerramos el libro
WbNuevoLibro. Close
'6. Cerramos el formulario. Ya no es necesario.
Unload Me
End Sub
Te puse en negritas el código que se tiene que agregar para crear el hipervínculo,
'aquí agregar el hipervínculo
Set celda = wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 4)
With celda
.Value = nombre
carpeta = "C:\Users\Salexis\Desktop\Lista Modificada\Estandares\"
ActiveSheet.Hyperlinks.Add Anchor:=celda, _
Address:=carpeta & .Value & ".pdf", _
ScreenTip:="Abrir " & .Value ', TextToDisplay:=nombre
End With
Set celda = Nothing
Lo que no sé es la carpeta en donde se encuentra el archivo, para que puedas crear la relación, sólo faltaría que la pusieras.
