Image dans entête via vba

Résolu/Fermé

Valoche01 Messages postés 43 Date d'inscription jeudi 29 novembre 2012 Statut Membre Dernière intervention 22 août 2017 - 3 juin 2014 à 15:06
Valoche01 Messages postés 43 Date d'inscription jeudi 29 novembre 2012 Statut Membre Dernière intervention 22 août 2017 - 11 juin 2014 à 15:48

Bonjour,

Après plusieurs essais et recherches, je n'arrive pas à insérer en entête de page, une image déjà enregistrée dans une feuille excel.

(J'ai un bouton en page de présentation qui permet à l'utilisateur d'ajouter une nouvelle page. Et c'est sur cette nouvelle page que je souhaite des entetes et pieds de page avec image. Ou alors sans VBA mais je ne sais pas faire non plus).

PS : L'image doit absolument être dans le fichier.

Merci d'avance pour votre aide!

A voir également:

Image dans entête via vba
Image iso - Guide
Acronis true image - Télécharger - Sauvegarde
Faststone image viewer - Télécharger - Visionnage & Diaporama
Google recherche par image - Guide
Image - Guide

3 réponses

Réponse 1 / 3

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
4 juin 2014 à 18:29

bonjour,

Voici 2 méthodes: image sur la feuille 1 et image dans le même dossier que le classeur:

Option Explicit
'Image sur la feuil1
Private Sub CommandButton1_Click()
Dim myDocument
Sheets("Feuil1").Select
Set myDocument = Worksheets(1) 'Sélection de la feuille
    myDocument.Shapes.SelectAll 'on sélectionne tout les Objets(image, bouton etc.) il faut qu'il n'y est que l'image! mettre l'image seule sur une feuille appropriée
    Selection.Copy
    Sheets("Feuil2").Select
    Range("K2").Select
    ActiveSheet.Paste
End Sub
'image dans le même dossier que le classeur
Sub InsertImage()
Dim MyCell As Range
Dim MyPicture As Picture
Dim image$
  image = [A1]
  Set MyCell = ActiveCell
  MyCell.Select
  Set MyPicture = ActiveSheet.Pictures.Insert(ActiveWorkbook.Path & "\Visionneuse.JPG")
  [A1] = ""
With MyPicture.ShapeRange
    .LockAspectRatio = msoFalse
    .Height = MyPicture.Height
    .Width = MyPicture.Width
  End With
  MyCell.Select
End Sub

A adapter suivant les besoins

Valoche01 Messages postés 43 Date d'inscription jeudi 29 novembre 2012 Statut Membre Dernière intervention 22 août 2017
Modifié par Valoche01 le 5/06/2014 à 11:17

Merci beaucoup, c'est déjà bien car j'arrive à récupérer l'image! Je suis entrain de chercher comment la mettre en pied de page maintenant.

Dim myDocument
Sheets("Feuil1").Select
Set myDocument = Worksheets(1)
    myDocument.Shapes.SelectAll
    Selection.Copy
    MsgBox Selection.Name   '   Elle s'appelle "Picture 1" par exemple

    ActiveSheet.PageSetup.CenterFooterPicture = Picture 1   '   Le problème est ici. Il faudrait un get Picture...

Je vais continuer de chercher, je vous dirai si je trouve :)

Merci

Réponse 2 / 3

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
5 juin 2014 à 11:48

Le plus simple est de trouvé la dernière ligne. Il y a plein d'exemple sur le sujet

Valoche01 Messages postés 43 Date d'inscription jeudi 29 novembre 2012 Statut Membre Dernière intervention 22 août 2017
5 juin 2014 à 12:03

Bien sur, sauf que ma dernière ligne est environ la 20ème car le reste est caché... Donc je suis obligé de passer par un pied de page. Je ne peux pas simplement me "placer en bas"

Réponse 3 / 3

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
6 juin 2014 à 12:35

J'ai trouvé une solution. En faisant les entêtes et pieds de page avec l'enregistreur de macro, je me suis aperçu qu'il fallait aller chercher le fichier image. J'ai donc fait une extraction de l'image en mettant l'image avec le classeur et ensuite par code il suffit d'aller la chercher avec la macro que j'ai enregistré en changeant simplement le chemin de l'image.

Donc voici le code:

Option Explicit
Dim sh As Shape
Private Sub CommandButton1_Click()
Extractionexcel
End Sub
Sub Extractionexcel()
 Dim myDocument
Sheets("Feuil1").Select
Set myDocument = Worksheets(1) 'Sélection de la feuille
    myDocument.Shapes.SelectAll 'on sélectionne tout les Objets(image, bouton etc.) il faut qu'il n'y ai que l'image! mettre l'image seule sur une feuille appropriée
    Selection.Copy
For Each sh In Sheets("Feuil1").Shapes
    Sheets("Feuil1").ChartObjects.Add(0, 0, sh.Width, sh.Height).Chart.Paste
     Sheets("Feuil1").ChartObjects(1).Chart.Export Filename:=ActiveWorkbook.Path & "\essai.jpg", FilterName:="jpg"
Next
End Sub
Sub inserer()
  ActiveWindow.View = xlPageLayoutView
    ActiveSheet.PageSetup.CenterHeaderPicture.Filename = _
        ActiveWorkbook.Path & "\essai.jpg"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = "&G"
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    ActiveSheet.PageSetup.CenterFooterPicture.Filename = _
       ActiveWorkbook.Path & "\essai.jpg"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = "&G"
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "&G"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
End Sub

A adapter suivant tes besoins comme dab

Si la macro de pied de page ne te conviens pas, tu te sers de l'enregistreur en modifiant les 2 chemin de l'image

Bonne programmation

Valoche01 Messages postés 43 Date d'inscription jeudi 29 novembre 2012 Statut Membre Dernière intervention 22 août 2017
11 juin 2014 à 15:48

C'est juste parfait !!! Je l'ai réadapté et ça fonctionne à merveille.

Merci beaucoup

Discussions similaires

Retrouver l'image originale après avoir fait des modifications ?

VBA : Range avec références variables..

code couleur associé a une image

Discussions similaires

Newsletters