Insertar archivo pdf en celda, con tamaño de celda

karrakilla · el 10 de noviembre

Buenos dias

Llevo toda la mañana buscando por el foro a ver si hay algo parecido a lo que busco, ero no encuentro nada.

A ver si alguien puede ayudarme.

Lo que busco, es una macro que al darle, me deje elegir un pdf de mi pc y me lo ajunte como icono en una celda en esa misma fila... con la posibilidad de modificar esa misma macro para varias filas mas.

Vamos que pueda tener varios pdf´s colocados igual, cada uno en su fila.

Gracias de antemano

Saludos

karrakilla · el 11 de noviembre

¿Es muy complicado lo que necesito, o no es posible?

YianTheJOP · el 11 de noviembre

A ver, no soy el más indicado para responderte. Yo lo que sí "logré" sacar en su día fue la manera de que según lo que pongas en una celda, te busque en una carpeta que tengas con PDFs y si encuentra la coincidencia te indique a solo in "Clik" de ratón el PDF y se abra.

No sé si me explico y es lo que necesitas.

YianTheJOP · el 11 de noviembre

Hace 5 minutos , YianTheJOP dijo:

A ver, no soy el más indicado para responderte. Yo lo que sí "logré" sacar en su día fue la manera de que según lo que pongas en una celda, te busque en una carpeta que tengas con PDFs y si encuentra la coincidencia te indique a solo in "Clik" de ratón el PDF y se abra.

No sé si me explico y es lo que necesitas.

Sub BuscadorPDF()

' **********************************************
Range("K7:L8").Select
Selection.ClearContents ' SE BORRA EL RANGO PARA COMENZAR CON LA HOJA LIMPIA
'
' **********************************************
Range("K8").Select


Directory = "C:\Users\javio\Desktop\PDF de prueba\" ' Disco Duro y CARPETA. TERMINAR CON \

FileName2 = Range("L6").Value & "*" & ".pdf"

sPath = Directory & FileName2

Dim vIn, vOut(), i As Long, c As Range
vIn = Filter(Split(CreateObject("WScript.Shell").exec("cmd /c Dir """ & sPath & """ /b /a-d /s").stdout.ReadAll, vbCrLf), ".")
On Error GoTo Fin
ReDim vOut(1 To 1 + UBound(vIn), 1 To 2)

With CreateObject("Scripting.FileSystemObject")
For i = 0 To UBound(vIn)
vOut(1 + i, 1) = .GetParentFolderName(vIn(i))
vOut(1 + i, 2) = .GetBaseName(vIn(i)) & "." & .GetExtensionName(vIn(i))
Next i
End With

With Range("K7").Resize(UBound(vOut, 1), UBound(vOut, 2))
.Value = vOut
For Each c In .Columns(2).Cells
.Parent.Hyperlinks.Add c, c(1, 0) & "\" & c.Value
Next c
End With

Columns("B").AutoFit

Exit Sub

Fin:

End Sub

karrakilla · el 12 de noviembre

Lo primero, muchas gracias...no es lo que busco porque los PDF pueden estar en cualquier parte del disco, pero me la guardo para otra.

Un saludo

karrakilla · el 13 de noviembre

¿Alguna otra día para poder hacerlo?

Antoni · el 13 de noviembre

Selecciona una celda y ejecuta la macro.

Sub LinkToPdf()
filetoopen = Application.GetOpenFilename("Archivos PDF (*.pdf), *.pdf")
If filetoopen <> False Then
   ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, ActiveCell.Left, ActiveCell.Top, _
                                                         ActiveCell.Width, ActiveCell.Height).Select
   With Selection.ShapeRange
      .TextFrame2.TextRange.Characters.Text = "PDF"
      .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
      .TextFrame2.VerticalAnchor = msoAnchorMiddle
      .TextFrame2.TextRange.Characters(1, 3).Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
      .TextFrame2.TextRange.Characters(1, 3).Font.Bold = msoTrue
      .Fill.ForeColor.RGB = RGB(255, 255, 255)
   End With
   ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:=filetoopen
   ActiveCell.Select
End If
End Sub