PDF en/of afbeelding plaatsen in excel

[ivoexcel]

Hallo,

Met onderstaande macro wil ik een afbeelding of pdf in een werkblad plakken. Met deze code kan ik een PDF plaatsen maar hoe kan ik ervoor zorgen dat dit ook werkt met een afbeelding?

Alvast bedankt!

Sub InsertFile()

ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)

Dim Asheet As Worksheet
Dim fPath As String
Dim myPdfObject As Object


Set Asheet = ActiveSheet
'Get file path
fPath = Application.GetOpenFilename("All Files,*.*", Title:="Select file")
    
If LCase(fPath) = "false" Then Exit Sub
    'Insert file
    Set myPdfObject = Asheet.OLEObjects.Add(Filename:=fPath, Link:=False, DisplayAsIcon:=False, Left:=1.5, Top:=1.5)
    myPdfObject.ShapeRange.LockAspectRatio = False
    myPdfObject.Border.Weight = xlThick
    myPdfObject.Border.LineStyle = xlNone
    myPdfObject.Height = 650
    myPdfObject.Width = 500

End Sub

 

[edmoor]

Op precies dezelfde manier, alleen kies je dan een afbeelding in plaats van een PDF bestand.

 

[ivoexcel]

Dan wordt de inhoud van de afbeelding niet geplakt helaas. Alleen het icoon van het afbeelding programma.

 

[edmoor]

Werkt hier prima, geen idee waarom bij jou niet.

 

[OctaFish]

Even wat morele ondersteuning: bij mij doet-ie het ook niet , ik krijg consequent een icoontje .

 

[edmoor]

Ik heb m'n bril op gezet en nog eens gekeken.
Hier ook niet

Lees dit eens:
https://www.mrexcel.com/board/threa...icture-from-a-folder-to-an-excel-file.799561/

 

[OctaFish]

Met een kleine aanpassing doet-ie het overigens verder prima.

Dim myPdfObject As Object, myImgObject As Object
 
    ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
    Set Asheet = ActiveSheet
    fPath = Application.GetOpenFilename("All Files,*.pdf", Title:="Select file")
    If LCase(fPath) = "false" Then Exit Sub
    Set myPdfObject = Asheet.OLEObjects.Add(FileName:=fPath, Link:=False, DisplayAsIcon:=False, Left:=1.5, Top:=1.5)
    With myPdfObject
        .ShapeRange.LockAspectRatio = True
        .Border.Weight = xlThick
        .Border.LineStyle = xlNone
        .Height = 650
        .Width = 500
    End With
    fPath = Application.GetOpenFilename("All Files,*.jpg", Title:="Select file")
    Set myImgObject = ActiveSheet.Pictures.Insert(fPath)
    With myImgObject
        .ShapeRange.LockAspectRatio = False
        .Border.Weight = xlThick
        .Border.LineStyle = xlNone
        .Height = 650
        .Width = 500
    End With

 

[edmoor]

Die werkt prima inderdaad

 

[ivoexcel]

Bedankt Octafish maar nu wordt eerst een PDF en daarna een afbeelding ingevoegd. Ik wil 1 invoegen maar keuze hebben in beide bestand formaten.

Ik heb nu onderstaande code. Deze doet precies wat die moet doen alleen moet de afbeelding nog links boven geplaats worden en een vast formaat (zoals bij de PDF).

ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)

Dim Asheet As Worksheet
Dim fPath As String
Dim myPdfObject As Object

Set Asheet = ActiveSheet
'Get file path
fPath = Application.GetOpenFilename("All Files,*.*", Title:="Select file")
    
If LCase(fPath) = "false" Then Exit Sub
If fPath Like "*.pdf" Then

    'Insert PDF file
    Set myPdfObject = Asheet.OLEObjects.Add(Filename:=fPath, Link:=False, DisplayAsIcon:=False, Left:=1.5, Top:=1.5)
    myPdfObject.ShapeRange.LockAspectRatio = False
    myPdfObject.Border.Weight = xlThick
    myPdfObject.Border.LineStyle = xlNone
    myPdfObject.Height = 650
    myPdfObject.Width = 500
    
Else
   'Insert Picture file
   Cells(1, 1).Select
   Asheet.Pictures.Insert(fPath).Select
End If

 

[ivoexcel]

Octafish uw code heb ik nu samen gevoegd met het stuk dat ik al had. Dat werkt pefect!

nu moet de afbeelding wel altijd geplaats worden vanaf cel A1.

Dim Asheet As Worksheet
Dim fPath As String
Dim myPdfObject As Object
Dim myImgObject As Object

Set Asheet = ActiveSheet
'Get file path
fPath = Application.GetOpenFilename("All Files,*.*", Title:="Select file")
    
If LCase(fPath) = "false" Then Exit Sub
If fPath Like "*.pdf" Then

    'Insert PDF file
    Set myPdfObject = Asheet.OLEObjects.Add(Filename:=fPath, Link:=False, DisplayAsIcon:=False, Left:=1.5, Top:=1.5)
    myPdfObject.ShapeRange.LockAspectRatio = False
    myPdfObject.Border.Weight = xlThick
    myPdfObject.Border.LineStyle = xlNone
    myPdfObject.Height = 650
    myPdfObject.Width = 500
    
Else
    Set myImgObject = Asheet.Pictures.Insert(fPath)
    With myImgObject
        .ShapeRange.LockAspectRatio = False
        .Border.Weight = xlThick
        .Border.LineStyle = xlNone
        .Height = 350
        .Width = 500
    End With
End If

 

[OctaFish]

Dit lijkt mij iets strakker:

If Right(fPath,3) = "pdf" Then

En ik zou ook zeker een ElseIf gebruiken om er voor te zorgen dat je voor het vervolg alleen jpg-tjes kan selecteren, en niet bijvoorbeeld ook een Word document. Want dan krijg je alsnog een foutmelding.

 

[ivoexcel]

Danke goede toevoeging inderdaad.

Hoe zorg ik ervoor dat de afbeelding altijd link boven geplaats wordt en niet midden op het blad?

onderstaande zou het ongeveer moeten zijn maar dat werkt niet

Set myImgObject = Asheet.Pictures.Insert(Filename:=fPath, Left:=1.5, Top:=1.5)

 

[snb]

een plaatje + PDF voeg je zó in in een werkblad:

Sub M_snb()
   Sheet1.Shapes.AddPicture "G:\OF\peer.jpg", 0, 1, Cells(1).Left, Cells(1).Top, 100, 100

   Sheet1.OLEObjects.Add(, "G:\OF\voor.pdf", 0, 0, , , , Cells(1).Left, Cells(1).Top, 650, 500).Border.LineStyle = xlNone
End Sub

 

[ivoexcel]

Thanks SNB!

Nu heb ik het precies zoals het moet

Onderstaande is de uitkomst. Bedankt allemaal!

Sub invoegen()

ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)

Dim Asheet As Worksheet
Dim fPath As String

Set Asheet = ActiveSheet
'Get file path
fPath = Application.GetOpenFilename("All Files,*.*", Title:="Select file")
    
If LCase(fPath) = "false" Then Exit Sub
If Right(fPath, 3) = "pdf" Then

    'Insert PDF file
    Asheet.OLEObjects.Add(, fPath, 0, 0, , , , Cells(1).Left, Cells(1).Top, 650, 500).Border.LineStyle = xlNone
     
Else
    'Insert picture
     Asheet.Shapes.AddPicture fPath, 0, 1, Cells(1).Left, Cells(1).Top, 350, 500
End If

End Sub

 

[snb]

Vermijd overbodige variabelen:

Sub M_snb()
  With Application.FileDialog(1)
    If .Show Then c00 = .SelectedItems(1)
  End With

  If c00 <> "" Then
    With ActiveWorkbook.Sheets.Add(, Sheets(Sheets.Count))
      If Right(c00, 3) = "pdf" Then .OLEObjects.Add(, c00, 0, 0, , , , Cells(1).Left, Cells(1).Top, 650, 500).Border.LineStyle = xlNone
      If Right(c00, 3) <> "pdf" Then .Shapes.AddPicture c00, 0, 1, Cells(1).Left, Cells(1).Top, 350, 500
    End With
  End If
End Sub