Mettre une image contenue dans une feuille en entête de page (VBA) Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Avatar du membre
78chris
Passionné d'Excel
Passionné d'Excel
Messages : 4'129
Appréciations reçues : 301
Inscrit le : 9 juillet 2017
Version d'Excel : 2010 à 2019 + 365

Message par 78chris » 15 septembre 2019, 20:37

RE
78chris a écrit :
15 septembre 2019, 18:58
Evite de citer le message précédent à chaque fois.
Les messages se suivent ici donc c'est inutile et consommateur de ressources...
Il y a tellement de redites dans ton code que j'en ai loupé... :oops:

EDIT code mis à jour
Il est totalement inutile d'activer l'onglet Image et on peut simplifier (éviter d'utiliser comme nom de variable un nom réservé du langage VBA comme path)
Sub Protectcollageentête(sh As Worksheet)
Dim shp As Object
Dim Chemin As String
Chemin= "C:\Temp\"
' vérifier l'existence de path'
If Dir(Chemin, vbDirectory) <> vbNullString Then
' si n'existe pas le créer
Else
MkDir (path)
End If
Chemin = "C:\Temp\entete"
Set Sh2 = Sheets("image")

Application.ScreenUpdating = False
For i = 1 To 3
    Set shp = Sh2.Shapes(i)
    shp.Copy
    
    'Colle l'image dans un graphique
    With Sh2.ChartObjects.Add(0, 0, shp.Width, shp.Height).Chart
        .Paste
        'Sauvegarde temporaire de l'image du graphique au format jpg
        .Export Chemin & i & ".jpg", "JPG"
    End With
 
    'Supprime le graphique
    With Sh2
        .ChartObjects(.ChartObjects.Count).Delete
    End With
    
Next i
    
With sh.PageSetup
    .LeftHeaderPicture.Filename = Chemin & "3.jpg"
    .LeftHeaderPicture.Height = 100
    .LeftHeaderPicture.LockAspectRatio = msoFalse
    .LeftHeaderPicture.Width = 150
    .LeftHeader = "&G"
    .RightHeaderPicture.Filename = Chemin & "2.jpg"
    .RightHeaderPicture.Height = 150
    .RightHeaderPicture.Width = 150
    .RightHeader = "&G"
    .CenterHeaderPicture.Filename = Chemin & "1.jpg"
    .CenterHeaderPicture.Height = 100
    .CenterHeaderPicture.Width = 100
    .CenterHeader = "&G"
End With

For i = 1 To 3
    Kill Chemin & i & ".jpg"
Next i

Application.ScreenUpdating = True
End Sub
Modifié en dernier par 78chris le 15 septembre 2019, 20:53, modifié 2 fois.
Chris
Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson.
Confucius
l
lefab
Jeune membre
Jeune membre
Messages : 10
Inscrit le : 14 septembre 2019
Version d'Excel : 2013

Message par lefab » 15 septembre 2019, 20:50

78chris a écrit :
15 septembre 2019, 20:37
RE
78chris a écrit :
15 septembre 2019, 18:58
Evite de citer le message précédent à chaque fois.
Les messages se suivent ici donc c'est inutile et consommateur de ressources...
Il y a tellement de redites dans ton code que j'en ai loupé... :oops:

Il est totalement inutile d'activer l'onglet Image et on peut simplifier
Sub Protectcollageentête(sh As Worksheet)
Dim shp As Object
Dim path As String
path = "C:\Temp\"
' vérifier l'existence de path'
If Dir(path, vbDirectory) <> vbNullString Then
' si n'existe pas le créer
Else
MkDir (path)
End If
Chemin = "C:\Temp\entete"
Set Sh2 = Sheets("image")

Application.ScreenUpdating = False
For i = 1 To 3
    Set shp = Sh2.Shapes(i)
    shp.Copy
    
    'Colle l'image dans un graphique
    With Sh2.ChartObjects.Add(0, 0, shp.Width, shp.Height).Chart
        .Paste
        'Sauvegarde temporaire de l'image du graphique au format jpg
        .Export Chemin & i & ".jpg", "JPG"
    End With
 
    'Supprime le graphique
    With Sh2
        .ChartObjects(.ChartObjects.Count).Delete
    End With
    
Next i
    
With sh.PageSetup
    .LeftHeaderPicture.Filename = Chemin & "3.jpg"
    .LeftHeaderPicture.Height = 100
    .LeftHeaderPicture.LockAspectRatio = msoFalse
    .LeftHeaderPicture.Width = 150
    .LeftHeader = "&G"
    .RightHeaderPicture.Filename = Chemin & "2.jpg"
    .RightHeaderPicture.Height = 150
    .RightHeaderPicture.Width = 150
    .RightHeader = "&G"
    .CenterHeaderPicture.Filename = Chemin & "1.jpg"
    .CenterHeaderPicture.Height = 100
    .CenterHeaderPicture.Width = 100
    .CenterHeader = "&G"
End With

For i = 1 To 3
    Kill Chemin & i & ".jpg"
Next i

Application.ScreenUpdating = True
End Sub
cool 78chris; c'est nickel à présent. grandement merci
Avatar du membre
78chris
Passionné d'Excel
Passionné d'Excel
Messages : 4'129
Appréciations reçues : 301
Inscrit le : 9 juillet 2017
Version d'Excel : 2010 à 2019 + 365

Message par 78chris » 15 septembre 2019, 20:55

RE

Tu ne lis pas ce que j'écris et tu persistes à citer pour rien !

J'ai édité mon poste et simplifié le code : c'est bien plus court et donc plus fiable
Chris
Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson.
Confucius
l
lefab
Jeune membre
Jeune membre
Messages : 10
Inscrit le : 14 septembre 2019
Version d'Excel : 2013

Message par lefab » 21 septembre 2019, 07:28

salut 78chris, bien sur que je lis ce que tu écris seulement lors du dernier post, je suis allé directement au code avant de lire ton message, donc c'est bon j'ai compris.
merci encore pour la simplification du code, c'est nickel ainsi. après avoir remplacé "path" par "Chemin", tout fonctionne à merveille sur n'importe quel poste. merci encore.
désolé pour la réponse en retard, j'étais en déplacement.
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message