Par macro ... j'aimerais afficher une bo=C3=AEte de dialogue pour s=C3=A9le=
ctionner une image et la placer dans l'ent=C3=AAte du centre sur toutes les=
feuilles du classeur.
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Michd
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 : 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,
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.
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 : 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.
rmillerlcxl
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,
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, 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.
rmillerlcxl
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.
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?
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.
Michd
| 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
| 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
'-------------------------------------------------------------------
| 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
rmillerlcxl
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.
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 ?
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.
Michd
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 .
'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
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 .