Mettre une image contenue dans une feuille en entête de page (VBA)
bonsoir à tous.
est - il possible de mettre une image "x" contenue dans une feuille en entête? Étant vraiment débutant en VBA, je ne trouve pas de solution pour référer l'image à l'entête à partir du bout de code trouvé en ligne.
par ailleurs, j'arrive à le faire si le fichier est stocké sur mon ordinateur. ci - joint le fichier d'essai avec le code dans le workbook
merci d'avance pour vos interventions
Bonjour
adresse du fichier doit être remplacé par le chemin et le nom du fichier temporaire de même que MonImage et fichier plus loin
Pour simplifier :
Sub ImageLeftHeaderPicture()
Dim sh As Object
Dim shp As Object
MonImage = "T:\TEMP\MonImage.jpg"
Set shp = Sheets("image").Shapes(1)
Set sh = ActiveSheet
shp.Copy
Application.ScreenUpdating = False
'Définit le nom et le lieu de stockage de l'image
Sheets("image").Activate
'Colle l'image dans un graphique
With ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height).Chart
.Paste
'Sauvegarde temporaire de l'image du graphique au format jpg
.Export MonImage, "JPG"
End With
'Supprime le graphique
With ActiveSheet
.ChartObjects(ActiveSheet.ChartObjects.Count).Delete
End With
sh.Activate
With ActiveSheet.PageSetup
.LeftHeaderPicture.Filename = MonImage
.LeftHeaderPicture.Height = 150
.LeftHeaderPicture.Width = 150
.LeftHeader = "&G"
.LeftFooterPicture.Filename = MonImage
.LeftFooterPicture.Height = 40
.LeftFooterPicture.Width = 40
.LeftFooter = "&G"
.CenterFooter = ActiveSheet.Cells(2, 2).Value
.RightFooter = "&P de &N"
End With
Kill MonImage
Application.ScreenUpdating = True
End Sub
Merci 78chris pour ta réponse, pour l'adresse du fichier j'avais compris mais pour la bout du code sur l'entête, non. je teste ça et je te fais signe.
maintenant, j'ai une inquiétude: vu que le but de la manœuvre est qu'en cas de changement de machine, que le fichier soit toujours disponible afin d'être ajouté en entête si elle venait à être changé intentionnellement ou pas, est ce que ce code assurera?
je teste et je vous retourne les résultats.
Merci 78chris pour ta réponse, pour l'adresse du fichier j'avais compris mais pour la bout du code sur l'entête, non. je teste ça et je te fais signe.
maintenant, j'ai une inquiétude: vu que le but de la manœuvre est qu'en cas de changement de machine, que le fichier soit toujours disponible afin d'être ajouté en entête si elle venait à être changé intentionnellement ou pas, est ce que ce code assurera?
je teste et je vous retourne les résultats.
comme je m'y attendais, ça ne marche pas lorsqu'on change de machine, le but c'est de référer l'image contenue déjà dans l'onglet image en entête pour une transportabilité sans contrainte.
d'autres solutions? quitte à changer complètement le code
RE
Le code prend l'image de l'onglet, en fait un fichier temporaire, reconstruit l'en-tête et détruit le fichier temporaire donc peu importe la machine...
RE
Le code prend l'image de l'onglet, en fait un fichier temporaire, reconstruit l'en-tête et détruit le fichier temporaire donc peu importe la machine...
Ah oui ! quel idiot je fais. en fait le problème est au niveau de l'exportation du fichier vers le répertoire temporaire. en fait il n'existe tout simplement pas d'où l'erreur. j'ai ajouté un bout de code qui vérifie l'existence du dossier et le crée s'il n'existe pas et là tout est nickel.
merci à toi 78chris
RE
Il faut utiliser un dossier qui existe sur toute machine.
En principe sur C: mais les autorisations peuvent être limitées
On peut utiliser le dossier Temp de Windows qu'on peut récupérer de deux façons
Soit par API
Private Declare PtrSafe Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Function GetTempDir() As String
Dim buffer As String * 256
Dim Length As Long
Length = GetTempPath(Len(buffer), buffer)
GetTempDir = Left(buffer, Length)
End Function
et on utilise alors une ligne de type DossTmp = GetTempDir
ou par FileSystemObject qui nécessite la référence Microsoft Scripting Runtime
'Activer Microsoft Scripting Runtime
Dim fso As FileSystemObject
Set fso = New FileSystemObject
DossTmp = fso.GetSpecialFolder(2) 'répertoire temp
RE
Il faut utiliser un dossier qui existe sur toute machine.
En principe sur C: mais les autorisations peuvent être limitées
On peut utiliser le dossier Temp de Windows qu'on peut récupérer de deux façons
Soit par API
Private Declare PtrSafe Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _ (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Function GetTempDir() As String Dim buffer As String * 256 Dim Length As Long Length = GetTempPath(Len(buffer), buffer) GetTempDir = Left(buffer, Length) End Function
et on utilise alors une ligne de type DossTmp = GetTempDir
ou par FileSystemObject qui nécessite la référence Microsoft Scripting Runtime
'Activer Microsoft Scripting Runtime Dim fso As FileSystemObject Set fso = New FileSystemObject DossTmp = fso.GetSpecialFolder(2) 'répertoire temp
reçu 78chris je garde ces codes sur la main au cas où. j'ai juste ajouté une ligne pour créer le dossier afin d'y coller les images et ça marche.
cependant je n'y comprends rien pour la suite de mon projet.
j'essaye en vain d'activer le code en cliquant juste sur une feuil3. A chaque fois la macro tourne en rond et excel fini par redémarrer. lorsque j'exécute la macro toute seule elle tourne sans problème. je te joins un fichier tu comprendras mieux. j'ai du mettre en commentaire la procédure d'appel pour pouvoir enregistré le fichier
autre remarque, en exécutant cette macro sur excel 2016, les images apparaissent toutes blanches, est ce un bug de 2016?
Bonjour
C'est le code de Worksheet_Activate qui appelle Protectcollageentête donc si tu remets sh.Activate dans cette procédure cela déclenche Worksheet_Activate...
Tu tournes en rond d'où le plantage
Il faudrait utiliser
call protectcollageentête(ActiveSheet) dans Worksheet_Activate
et
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
MonImage1 = "C:\Temp\entete1.jpg"
MonImage2 = "C:\Temp\entete2.jpg"
MonImage3 = "C:\Temp\entete3.jpg"
Set shp1 = Sheets("image").Shapes(1)
Set shp2 = Sheets("image").Shapes(2)
Set shp3 = Sheets("image").Shapes(3)
shp1.Copy
Application.ScreenUpdating = False
'Définit le nom et le lieu de stockage de l'image
Sheets("image").Activate
'Colle l'image dans un graphique
With sh.ChartObjects.Add(0, 0, shp1.Width, shp1.Height).Chart
.Paste
'Sauvegarde temporaire de l'image du graphique au format jpg
.Export MonImage1, "JPG"
End With
'Supprime le graphique
With sh
.ChartObjects(ActiveSheet.ChartObjects.Count).Delete
End With
shp2.Copy
With sh.ChartObjects.Add(0, 0, shp2.Width, shp2.Height).Chart
.Paste
'Sauvegarde temporaire de l'image du graphique au format jpg
.Export MonImage2, "JPG"
End With
'Supprime le graphique
With ws
.ChartObjects(ActiveSheet.ChartObjects.Count).Delete
End With
shp3.Copy
With sh.ChartObjects.Add(0, 0, shp3.Width, shp3.Height).Chart
.Paste
'Sauvegarde temporaire de l'image du graphique au format jpg
.Export MonImage3, "JPG"
End With
'Supprime le graphique
With sh
.ChartObjects(ActiveSheet.ChartObjects.Count).Delete
End With
With sh.PageSetup
.LeftHeaderPicture.Filename = MonImage3
.LeftHeaderPicture.Height = 100
.LeftHeaderPicture.LockAspectRatio = msoFalse
.LeftHeaderPicture.Width = 150
.LeftHeader = "&G"
.RightHeaderPicture.Filename = MonImage2
.RightHeaderPicture.Height = 150
.RightHeaderPicture.Width = 150
.RightHeader = "&G"
.CenterHeaderPicture.Filename = MonImage1
.CenterHeaderPicture.Height = 100
.CenterHeaderPicture.Width = 100
.CenterHeader = "&G"
End With
Kill MonImage1
Kill MonImage2
Kill MonImage3
Application.ScreenUpdating = True
End Sub
Néanmoins je trouve lourding de déclencher cela à chqaue activation de la feuille.
Il faudrait gérer une variable static pour ne le faire qu'une fois...
Evite de citer le message précédent à chaque fois.
Les messages se suivent ici donc c'est inutile et consommateur de ressources...
Bonjour
C'est le code de Worksheet_Activate qui appelle Protectcollageentête donc si tu remets sh.Activate dans cette procédure cela déclenche Worksheet_Activate...
Tu tournes en rond d'où le plantage
Il faudrait utiliser
call protectcollageentête(ActiveSheet) dans Worksheet_Activate
et
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 MonImage1 = "C:\Temp\entete1.jpg" MonImage2 = "C:\Temp\entete2.jpg" MonImage3 = "C:\Temp\entete3.jpg" Set shp1 = Sheets("image").Shapes(1) Set shp2 = Sheets("image").Shapes(2) Set shp3 = Sheets("image").Shapes(3) shp1.Copy Application.ScreenUpdating = False 'Définit le nom et le lieu de stockage de l'image Sheets("image").Activate 'Colle l'image dans un graphique With sh.ChartObjects.Add(0, 0, shp1.Width, shp1.Height).Chart .Paste 'Sauvegarde temporaire de l'image du graphique au format jpg .Export MonImage1, "JPG" End With 'Supprime le graphique With sh .ChartObjects(ActiveSheet.ChartObjects.Count).Delete End With shp2.Copy With sh.ChartObjects.Add(0, 0, shp2.Width, shp2.Height).Chart .Paste 'Sauvegarde temporaire de l'image du graphique au format jpg .Export MonImage2, "JPG" End With 'Supprime le graphique With ws .ChartObjects(ActiveSheet.ChartObjects.Count).Delete End With shp3.Copy With sh.ChartObjects.Add(0, 0, shp3.Width, shp3.Height).Chart .Paste 'Sauvegarde temporaire de l'image du graphique au format jpg .Export MonImage3, "JPG" End With 'Supprime le graphique With sh .ChartObjects(ActiveSheet.ChartObjects.Count).Delete End With With sh.PageSetup .LeftHeaderPicture.Filename = MonImage3 .LeftHeaderPicture.Height = 100 .LeftHeaderPicture.LockAspectRatio = msoFalse .LeftHeaderPicture.Width = 150 .LeftHeader = "&G" .RightHeaderPicture.Filename = MonImage2 .RightHeaderPicture.Height = 150 .RightHeaderPicture.Width = 150 .RightHeader = "&G" .CenterHeaderPicture.Filename = MonImage1 .CenterHeaderPicture.Height = 100 .CenterHeaderPicture.Width = 100 .CenterHeader = "&G" End With Kill MonImage1 Kill MonImage2 Kill MonImage3 Application.ScreenUpdating = True End Sub
Néanmoins je trouve lourding de déclencher cela à chqaue activation de la feuille.
Il faudrait gérer une variable static pour ne le faire qu'une fois...
Evite de citer le message précédent à chaque fois.
Les messages se suivent ici donc c'est inutile et consommateur de ressources...
ok! après avoir utilisé le code tel que décrit, j'ai eu des erreurs au niveau des charts impossible de les créer car à l'intérieur il y avait encore activesheet que j'ai enlevé ça tourne maintenant sauf qu'il est impossible de sélectionner la feuil3 en question, la macro s’achevant sur la feuille image.
Private Sub Worksheet_Activate()
Call Protectcollageentête(ActiveSheet)
End Sub
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
MonImage1 = "C:\Temp\entete1.jpg"
MonImage2 = "C:\Temp\entete2.jpg"
MonImage3 = "C:\Temp\entete3.jpg"
Set shp1 = Sheets("image").Shapes(1)
Set shp2 = Sheets("image").Shapes(2)
Set shp3 = Sheets("image").Shapes(3)
shp1.Copy
Application.ScreenUpdating = False
'Définit le nom et le lieu de stockage de l'image
Sheets("image").Activate
'Colle l'image dans un graphique
With sh.ChartObjects.Add(0, 0, shp1.Width, shp1.Height).Chart
.Paste
'Sauvegarde temporaire de l'image du graphique au format jpg
.Export MonImage1, "JPG"
End With
'Supprime le graphique
With sh
' .ChartObjects(Worksheet.ChartObjects.Count).Delete
.ChartObjects.Delete
End With
shp2.Copy
With sh.ChartObjects.Add(0, 0, shp2.Width, shp2.Height).Chart
.Paste
'Sauvegarde temporaire de l'image du graphique au format jpg
.Export MonImage2, "JPG"
End With
'Supprime le graphique
With sh
' .ChartObjects(ActiveSheet.ChartObjects.Count).Delete
.ChartObjects.Delete
End With
shp3.Copy
With sh.ChartObjects.Add(0, 0, shp3.Width, shp3.Height).Chart
.Paste
'Sauvegarde temporaire de l'image du graphique au format jpg
.Export MonImage3, "JPG"
End With
'Supprime le graphique
With sh
' .ChartObjects(ActiveSheet.ChartObjects.Count).Delete
.ChartObjects.Delete
End With
With sh.PageSetup
.LeftHeaderPicture.Filename = MonImage3
.LeftHeaderPicture.Height = 100
.LeftHeaderPicture.LockAspectRatio = msoFalse
.LeftHeaderPicture.Width = 150
.LeftHeader = "&G"
.RightHeaderPicture.Filename = MonImage2
.RightHeaderPicture.Height = 150
.RightHeaderPicture.Width = 150
.RightHeader = "&G"
.CenterHeaderPicture.Filename = MonImage1
.CenterHeaderPicture.Height = 100
.CenterHeaderPicture.Width = 100
.CenterHeader = "&G"
End With
Kill MonImage1
Kill MonImage2
Kill MonImage3
Application.ScreenUpdating = True
End Sub
RE
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é...
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
RE
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é...
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
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
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.