Discussion :

[jurassic pork]

Hello,
Avec ce code pour insérer un document PDF dans une feuille Excel avec mise à l'échelle :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub InsererPDF()
Dim docPDF
Worksheets("Feuil1").OLEObjects.Add Null, "D:\Dev\Office\Excel\Doc1.pdf", msoFalse, msoFalse
Set docPDF = Worksheets("Feuil1").Shapes(Worksheets("Feuil1").Shapes.Count)
Debug.Print docPDF.Type
Select Case docPDF.Type
      Case msoEmbeddedOLEObject, msoLinkedOLEObject, _
            msoOLEControlObject, msoLinkedPicture, msoPicture
        docPDF.ScaleHeight 0.5, msoTrue
        docPDF.ScaleWidth 0.5, msoTrue
      Case Else
        docPDF.ScaleHeight 0.5, msoFalse
        docPDF.ScaleWidth 0.5, msoFalse
End Select
End Sub

j'ai systématiquement une erreur sur la ligne docPDF.ScaleHeight 0.5, msoTrue

Erreur d'exécution '-2147024809 (80070057)':
L'argument ProportionnelTailleOrigine ne s'applique qu'à une image ou un objet Ole.

Alors que docPDF est de type 7 c'est à dire msoEmbeddedOLEObject.

version d'Excel : Microsoft® Excel® 2016 MSO (Version 2111 Build 16.0.14701.20204) 32 bits en français

Ami calmant, J.P


[/QUOTE]

[jurassic pork]

Même souci avec Excel 2019 et un fichier jpeg comme objet OLE.

[Ben_L]

Bonjour,

Je ne comprends pour l'instant pas pourquoi, mais le code suivant fonctionne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
    Dim obj As OLEObject
    With ThisWorkbook.Sheets(1)
        .OLEObjects.Add Filename:="C:\Temp\MyFile.pdf"
        For Each obj In .OLEObjects
            With obj.ShapeRange
                .ScaleHeight 1, msoTrue
                .ScaleWidth 1, msoTrue
            End With
        Next obj
    End With

mais pas celui-ci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
    Dim docPDF As OLEObject
    Set docPDF = ThisWorkbook.Sheets(1).OLEObjects.Add(Filename:="C:\Temp\MyFile.pdf")
    docPDF.ShapeRange.ScaleHeight 1#, msoTrue
    docPDF.ShapeRange.ScaleWidth 1#, msoTrue

Je suis un peu perdu . Si un expert passe par là...

[jurassic pork]

merci Ben_L pour ta solution dans le premier code. Effectivement le problème du deuxième code et de mon code est assez mystérieux car les objets obj.ShapeRange et docPDF.ShapeRange se ressemblent beaucoup. Avant de mettre le sujet en résolu j'attend de voir si quelqu'un a une explication à ce mystère.

[EDIT] Indice supplémentaire :
ceci ne fonctionne pas non plus :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ThisWorkbook.Sheets(1).OLEObjects(1).ShapeRange.ScaleHeight 0.5, msoTrue

Alors que le for each obj fonctionne.

[jurassic pork]

hello,
finalement cela ressemble fortement à un bug, car même avec comme objet OLE une image BMP et en étant sous Excel 2019, il y a la même erreur.
Code pour reproduire le problème :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub InsertOLE()
Dim obj As OLEObject
Dim OleImage As OLEObject
Set OleImage = ThisWorkbook.Sheets(1).OLEObjects.Add(Filename:="D:\Temp\Images\JurassicPork.bmp")
OleImage.ShapeRange.ScaleHeight 4#, msoTrue 'NOK -> see Error Message
'OleImage.ShapeRange.ScaleWidth 4#, msoTrue 'NOK
For Each obj In ThisWorkbook.Sheets(1).OLEObjects
    obj.ShapeRange.ScaleHeight 4, msoTrue  'OK
    obj.ShapeRange.ScaleWidth 4, msoTrue   'OK
    obj.ShapeRange.Top = Range("I10").Top
    obj.ShapeRange.Left = Range("I10").Left
Next obj
End Sub

Message d'erreur :


Ami calmant, J.P