Image dans entête via vba

Résolu
Valoche01 Messages postés 45 Statut Membre -  
Valoche01 Messages postés 45 Statut Membre -
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!

3 réponses

  1. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    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

    0
    1. Valoche01 Messages postés 45 Statut Membre
       
      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
      0
  2. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Le plus simple est de trouvé la dernière ligne. Il y a plein d'exemple sur le sujet
    0
    1. Valoche01 Messages postés 45 Statut Membre
       
      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"
      0
  3. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    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
    0
    1. Valoche01 Messages postés 45 Statut Membre
       
      C'est juste parfait !!! Je l'ai réadapté et ça fonctionne à merveille.

      Merci beaucoup
      0