crear hipervinculo y llamar archivo PDF desde excel con VBA en
Publicado por ric (1 intervención) el 23/03/2017 00:23:24
buenas tardes...
requiero de su ayuda si me dan la solucion a una funcion de hipervinculo en excel con VBA
explico lo que requiere que haga:
tengo un archivo de excel en el cual se lleva un control de vales de entradas y salidas en cada celda se describe su concepto, en especifica una celda se anota el consecutivo del vale el cual esta en formato PDF y con nombre mas detallado, requiero que desde esa celda al momento de meter cierta parte del consecutivo del nombre del PDF esta celda con ese criterio se convierta en hipervinculo y que con el clic me abra el archivo del PDF.
en la celda B8 solo anoto parte del nombre del archivo y el archivo en si tiene un nombre mas amplio porngo ejemplo:
celda B8 "vale-007-2017" y el archivo PDF su nombre real es 170101_vale-007-2017 repuesto.pdf
esta es la funcion que hice, si crea el hipervinculo pero solo me llega abrir hasta la carpeta donde se encuentra alojado el archivo de PDF, y requiero que haga tambien el abrir el archivo de PDF, alguien me puede ayudar a decirme si algo hace falta o que haya corregir...
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim texto As String
On Error GoTo Err_vinculo
texto = Target.Value
Dim cachar As String
' Dim contador As Integer
'contador = 0
'For contador = 8 To 1048576
'texto = Range("b" & contador)
Dim final As String
If Target.Column = 2 Then
If texto <> "" Then
If IsNull(texto) = False Then
If Left(Range("a" & Target.Row), 7) = "ENTRADA" Then
'If Left(Range("a" & contador), 7) = "ENTRADA" Then
cachar = Dir("\\D:\ALMACEN\VALES\ENTRADA\" + texto + "*.pdf")
final = (Replace(cachar, " ", "%20", , , vbTextCompare))
' Range("b" & contador).Hyperlinks.Add Range("b" & contador), "Entrada\" + final
'Range("b" & Target.Row).Hyperlinks.Delete
Selection.Hyperlinks.Add Target, "ENTRADA\" + final
End If
If Left(Range("a" & Target.Row), 7) = "SALIDA" Then
' If Left(Range("a" & contador), 7) = "SALIDA" Then
cachar = Dir("\\D:\ALMACEN\VALES\SALIDA\" + texto + "*.pdf")
final = (Replace(cachar, " ", "%20", , , vbTextCompare))
' Range("b" & contador).Hyperlinks.Add Range("b" & contador), "Salida\" + final
' Range("b" & Target.Row).Hyperlinks.Delete
Selection.Hyperlinks.Add Target, "SALIDA\" + final
End If
End If 'de isnull
End If 'de la columna que se esta agregando hipervinculos
End If
'Next contador
Exit_Workbook_SheetChange:
Exit Sub
Err_vinculo:
MsgBox Err.Description
Resume Exit_Workbook_SheetChange
End Sub
****************************************************
saludos......
requiero de su ayuda si me dan la solucion a una funcion de hipervinculo en excel con VBA
explico lo que requiere que haga:
tengo un archivo de excel en el cual se lleva un control de vales de entradas y salidas en cada celda se describe su concepto, en especifica una celda se anota el consecutivo del vale el cual esta en formato PDF y con nombre mas detallado, requiero que desde esa celda al momento de meter cierta parte del consecutivo del nombre del PDF esta celda con ese criterio se convierta en hipervinculo y que con el clic me abra el archivo del PDF.
en la celda B8 solo anoto parte del nombre del archivo y el archivo en si tiene un nombre mas amplio porngo ejemplo:
celda B8 "vale-007-2017" y el archivo PDF su nombre real es 170101_vale-007-2017 repuesto.pdf
esta es la funcion que hice, si crea el hipervinculo pero solo me llega abrir hasta la carpeta donde se encuentra alojado el archivo de PDF, y requiero que haga tambien el abrir el archivo de PDF, alguien me puede ayudar a decirme si algo hace falta o que haya corregir...
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim texto As String
On Error GoTo Err_vinculo
texto = Target.Value
Dim cachar As String
' Dim contador As Integer
'contador = 0
'For contador = 8 To 1048576
'texto = Range("b" & contador)
Dim final As String
If Target.Column = 2 Then
If texto <> "" Then
If IsNull(texto) = False Then
If Left(Range("a" & Target.Row), 7) = "ENTRADA" Then
'If Left(Range("a" & contador), 7) = "ENTRADA" Then
cachar = Dir("\\D:\ALMACEN\VALES\ENTRADA\" + texto + "*.pdf")
final = (Replace(cachar, " ", "%20", , , vbTextCompare))
' Range("b" & contador).Hyperlinks.Add Range("b" & contador), "Entrada\" + final
'Range("b" & Target.Row).Hyperlinks.Delete
Selection.Hyperlinks.Add Target, "ENTRADA\" + final
End If
If Left(Range("a" & Target.Row), 7) = "SALIDA" Then
' If Left(Range("a" & contador), 7) = "SALIDA" Then
cachar = Dir("\\D:\ALMACEN\VALES\SALIDA\" + texto + "*.pdf")
final = (Replace(cachar, " ", "%20", , , vbTextCompare))
' Range("b" & contador).Hyperlinks.Add Range("b" & contador), "Salida\" + final
' Range("b" & Target.Row).Hyperlinks.Delete
Selection.Hyperlinks.Add Target, "SALIDA\" + final
End If
End If 'de isnull
End If 'de la columna que se esta agregando hipervinculos
End If
'Next contador
Exit_Workbook_SheetChange:
Exit Sub
Err_vinculo:
MsgBox Err.Description
Resume Exit_Workbook_SheetChange
End Sub
****************************************************
saludos......
Valora esta pregunta


0