Insertion d'image en-tête

Version imprimable

02/02/2010, 14h07
arkaramasof

Insertion d'image en-tête

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.

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:

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+

03/02/2010, 15h47
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

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

Essaies ceci:
Code:

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 :aie:

A+