Insérer une image par une boîte de dialogue

Bonjour,

Fait un copier-coller de tout le code vers le ThisWorkbook du projetVBA de
ton classeur.
Après tes tests, n'oublie pas de remplacer ".PrintPreview par .PrintOut

Avant de lancer l'impression, tu dois sélectionner les onglets des feuilles
que tu veux imprimer.
Seulement quelques feuilles ou toutes les feuilles, et ce, afin de te
laisser plus de liberté sur ce que tu veux imprimer à chaque impression.

'-------------------------------------------------------------------
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim Image As String
Cancel = True
Image = Rechercher_Une_Image()
Application.EnableEvents = False
For Each Sh In ActiveWindow.SelectedSheets
With Sh
'à adapter au besoin
.PageSetup.TopMargin = Application.InchesToPoints(0.6)
.PageSetup.DifferentFirstPageHeaderFooter = False
.PageSetup.LeftHeader = "&G" 'Permet l'affichage de l'image
.PageSetup.LeftHeaderPicture.Filename = Image
'Après test, replacer PrintPreview par .printout
.PrintPreview
End With
Next
Application.EnableEvents = True
End Sub
'-------------------------------------------------------------------
Function Rechercher_Une_Image()
Dim Répertoire As String, LeRep As String
Dim Fichier As String, Wk As Workbook
Dim File As String

'Le répertoire à partir duquel l'usager
'peut choisir dans la panoplie de sous-répertoires
'Cet élément est optionel
Répertoire = Environ("UserProfile") & "Pictures"

If Dir(Répertoire, vbDirectory) <> "" Then
'Si dans la fenêtre ouvrante, l'usager
'clique sur annuler, c'est le "Répertoire"
'qui est utilisé...
LeRep = BrowseFile(Répertoire) & ""
If LeRep = "" Then
LeRep = ""
End If
Else
LeRep = ""
End If
Rechercher_Une_Image = BrowseFile(LeRep)
End Function
'-------------------------------------------------------------------
Function BrowseFile(Optional Chemin As String) As String
With Application.FileDialog(msoFileDialogFilePicker)
'Définit un titre pour la boîte de dialogue
.Title = "Choisir le répertoire"
'Empêcher la multi-sélection
.AllowMultiSelect = False
'Répertoire par défaut suivi du type de fichier par défaut
.InitialFileName = Chemin
'Affiche la boîte de dialogue
.Show
'Si un fichier a été sélectionné
If .SelectedItems.Count = 1 Then
BrowseFile = .SelectedItems(1)
Else
BrowseFile = ""
End If
End With
End Function
'-------------------------------------------------------------------

MichD

a écrit dans le message de groupe de discussion :
6758ddc6-bc4e-49cc-9990-80675f5040d6@googlegroups.com...

Bonjour,

Par macro ... j'aimerais afficher une boîte de dialogue pour sélectionner
une image et la placer dans l'entête du centre sur toutes les feuilles du
classeur.

Est-ce que cela serait possible?

Merci à l'avance.

Bonjour,

Wow! Un énorme merci. J'ai adapté le code à la situation et tout est parfait.

Le code que vous m'avez remis est super.

J'avais besoin de lancer une macro à partir d'un bouton pour insé rer une image dans toutes les feuilles du classeur.

Bonjour à nouveau,

Je me demande ... y aurait-il un moyen de faire en sorte que si la sél ection n'est pas une image ... que l'opération avorte?

Est-ce qu'il faut mettre une condition par extension ... type de fichier .. . ou?

Merci à l'avance.

| y aurait-il un moyen de faire en sorte que si la sélection n'est pas une
image ... que l'opération avorte?

**** Bien sûr :
Dans la procédure "Imprimer" j'ai ajouté cette ligne de code :
If Image = "" Then Exit Sub

Dans la procédure BrowseFile , j'ai ajouté ceci :
'Affiche seulement les fichiers ayant ce type d'extension.
'Tu peux ajouter toutes les extensions de fichier dont tu veux
'en les séparant pas un point virgule

.Filters.Add "Classeurs Excel", "*.jpg; *.gif"

Par conséquent, seuls les fichiers ayant ces extensions s'afficheront dans
la boîte de dialogue.

'-------------------------------------------------------------------
Sub Imprimer()
Dim Image As String
Cancel = True
Image = Rechercher_Une_Image()
If Image = "" Then Exit Sub
Application.EnableEvents = False
For Each Sh In ActiveWindow.SelectedSheets
With Sh
'à adapter au besoin
.PageSetup.TopMargin = Application.InchesToPoints(0.6)
.PageSetup.DifferentFirstPageHeaderFooter = False
.PageSetup.LeftHeader = "&G" 'Permet l'affichage de l'image
.PageSetup.LeftHeaderPicture.Filename = Image
'Après test, replacer PrintPreview par .printout
.PrintPreview
End With
Next
Application.EnableEvents = True
End Sub
'-------------------------------------------------------------------
Function Rechercher_Une_Image()
Dim Répertoire As String, LeRep As String
Dim Fichier As String, Wk As Workbook
Dim File As String

'Le répertoire à partir duquel l'usager
'peut choisir dans la panoplie de sous-répertoires
'Cet élément est optionnel
Répertoire = Environ("UserProfile") & "Pictures"

If Dir(Répertoire, vbDirectory) <> "" Then
'Si dans la fenêtre ouvrante, l'usager
'clique sur annuler, c'est le "Répertoire"
'qui est utilisé...
LeRep = BrowseFile(Répertoire) & ""
If LeRep = "" Then
LeRep = ""
End If
Else
LeRep = ""
End If
Rechercher_Une_Image = BrowseFile(LeRep)
End Function
'-------------------------------------------------------------------
Function BrowseFile(Optional Chemin As String) As String
With Application.FileDialog(msoFileDialogFilePicker)
'Définit un titre pour la boîte de dialogue
.Title = "Choisir le répertoire"
'Empêcher la multi-sélection
.AllowMultiSelect = False
'Répertoire par défaut suivi du type de fichier par défaut
.InitialFileName = Chemin
'Affiche seulement les fichiers ayant ce type d'extension.
'Tu peux ajouter tous les extensions de fichier que tu veux
'en les séparant pas un point virgule
.Filters.Add "Classeurs Excel", "*.jpg; *.gif"
'Affiche la boîte de dialogue
.Show
'Si un fichier a été sélectionné
If .SelectedItems.Count = 1 Then
BrowseFile = .SelectedItems(1)
Else
BrowseFile = ""
End If
End With
End Function
'-------------------------------------------------------------------

MichD

Super! Un grand merci ... encore.

Pour ma connaissance ... pour la ligne ...

"Filters.Add "Classeurs Excel", "*.jpg; *.gif" "

"Classeurs Excel" doit être là ... pas comme type de fichier d'im age mais ???


Aussi ... "Classeurs Excel" va fonctionner quelque soit la version de Excel ?

Merci à l'avance.

Remplace
"Filters.Add "Classeurs Excel", "*.jpg; *.gif" "

Par :

'Affiche seulement les fichiers ayant ce type d'extension.
'Tu peux ajouter tous les extensions de fichier que tu veux
'en les séparant pas un point virugle
.Filters.Add "JPG", "*.jpg;*.jepg;*.jpe;*.jfif)", 1
.Filters.Add "GIF", "*.gif", 2
.Filters.Add "TIF", "*.tif;*.tiff", 3
.Filters.Add "BITMAP", "*.bmp,*.dib", 4
'Définit le filtre qui s'affiche par défaut
'dans le champ "Type de fichiers".
.FilterIndex = 2


MichD

.