Discussion :

[arkaramasof]

Bonjour à tous,

Voilà, mon problème est que je souhaite insérer une image dans l'en-tête de mes feuilles (un logo).
Je sais qu'il est possible de passer par un chemin mais je souhaite éviter cette solution car si on déplace l'image il va y avoir des problèmes.

L'image que je souhaite insérer se trouve dans ma Feuil3 sous le nom de "Image 1". Je voulais donc savoir s'il est possible de l'insérer dans mon en-tête en utilisant ce nom "Image 1".

Merci pour vos réponses.

[Fvandermeulen]

Salut,
Je me suis largement inspiré d'un de mes codes qui passe par une copie sur un fichier temporaire afin de faire une sauvegarde en format JPG, du coup il y a peut-être moyen de simplifier mais j'ai pas le temps de chercher...

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
16
17
18
19
20
21
Sub EnTeteImage()
'
Dim S As Shape
Application.ScreenUpdating = False 'Fige la mise à jour de l'écran
 
Set S = Sheets("sheet3").Shapes(1) 'Affecte l'image à la variable S
S.CopyPicture 'Copie l'image
Workbooks.Add 'Crée un nouveau fichier
ActiveSheet.Paste 'Colle l'image
With ActiveSheet.ChartObjects.Add(0, 0, S.Width, S.Height).Chart
    .Paste
    .Export "I:\Temp\Image.jpg", "jpg" 'Sauvegarde l'image en format JPG
End With
ActiveWorkbook.Close False 'Ferme le fichier Excel temporaire sans sauver
 
ActiveSheet.PageSetup.LeftHeaderPicture.Filename = _
        "I:\Temp\Image.jpg" 'Place l'image dans l'en-tête
 
Application.ScreenUpdating = True
 
End Sub

A+

[arkaramasof]

Merci pour cette solution qui fonctionne en partie.

Le problème est que mon image est de mauvaise qualité après l'enregistrement.
Je n'ai pas trouvé le moyen de conserver la qualité d'origine. En plus de cela une bordure vient entourer mon image alors que l'image d'origine n'en a pas.

Si quelqu'un connait une solution ... je suis preneur

Merci

[Fvandermeulen]

Re,
J'ai pensé à autre chose...

Essaies ceci:

Code :

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

1
2
3
4
5
6
7
8
Sub EnTeteImageV2()
 
    Sheets("Sheet3").Copy
    ActiveWorkbook.SaveAs Filename:="C:\temp\Image.htm", FileFormat:=xlHtml
    ActiveWindow.Close False
    ActiveSheet.PageSetup.CenterHeaderPicture.Filename = "C:\temp\Image_files\image001.jpg"
 
End Sub

Je suis au boulot, j'ai pas su tester le code tel quel, j'ai pas accès au temp

A+