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

[karrakilla]

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]

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

[YianTheJOP]

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]

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]

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]

¿Alguna otra día para poder hacerlo?

[Antoni]

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

 

[karrakilla]

Muchas gracias Antoni, pero tampoco es lo que busco ya que no adjunta el pdf, si no que hace un hipervinculo a el.

Lo que necesito es que al enviar el excel puedan ver esos pdf adjuntos.

Muchas gracias de nuevo por tu tiempo y me guardo el codigo para otra idea que tengo en mente.

Un Saludo.

[karrakilla]

Alguna idea mas??