Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Commente insérer mon logo dans l'entête avec VBA?

12 réponses
Avatar
Emile
Bonjour a tous,

Je cherche a insérer mon logo dans l'entête de certains documents a l'aide
d'un bouton. Mais je n'y arrive pas..
Voici, le résultat (lamentable) de mon essai...
Est-ce que quelqu'un pourrait me prêter un peu d'aide ?
--------------------------------------------------------------
Sub MonEnteteDocument()
Dim MonLogo As String
MonLogo = "\C:\Documents and Settings\Administrateur\Mes documents\Mes
images\Logo.bmp"
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.ParagraphFormat.TabStops.ClearAll
With Selection
.ParagraphFormat.Alignment = wdAlignParagraphRight
.InlineShapes.AddPicture FileName:=MonLogo, _
LinkToFile:=False, SaveWithDocument:=True
End With

' Jusqu'ici tout va bien.. Mais une fois le logo insérer (il est trop
grand),
' je n'arrive pas a le sélectionner pour le redimensionner, comme plus
bas...
' tout ce qui suit (fait avec l'enregistreur) ne fonctionne pas,
' car mon logo n'est PAS sélectionné...

Selection.InlineShapes(1).Activate
Selection.InlineShapes(1).PictureFormat.Brightness = 0.5
Selection.InlineShapes(1).PictureFormat.Contrast = 0.5
Selection.InlineShapes(1).PictureFormat.ColorType = msoPictureAutomatic
Selection.InlineShapes(1).PictureFormat.CropLeft = 0#
Selection.InlineShapes(1).PictureFormat.CropRight = 0#
Selection.InlineShapes(1).PictureFormat.CropTop = 0#
Selection.InlineShapes(1).PictureFormat.CropBottom = 0#
Selection.InlineShapes(1).Fill.Visible = msoFalse
Selection.InlineShapes(1).Fill.Solid
Selection.InlineShapes(1).Fill.Transparency = 0#
Selection.InlineShapes(1).Line.Weight = 0.75
Selection.InlineShapes(1).Line.Transparency = 0#
Selection.InlineShapes(1).Line.Visible = msoFalse
Selection.InlineShapes(1).LockAspectRatio = msoTrue
Selection.InlineShapes(1).Height = 57#
Selection.InlineShapes(1).Width = 69.75
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub
--------------------------------------------------------------
Meci d'avance pour votre aide,
Cordialement,

Emile63

10 réponses

1 2
Avatar
Anacoluthe
Bonjour !

'Emile' nous a écrit ...
Je cherche a insérer mon logo dans l'entête de certains documents a l'aide
d'un bouton. Mais je n'y arrive pas..



Lors de l'insertion du logo créez un OBJET pour lui
(VBA est un langage à objets !)
vous utiliserez ensuite cet objet pour en modifier ses propriétés
Vous n'avez même pas besoin de le sélectionner !

J'ai gardé le début de votre macro qui sélectionne l'en-tête
mais là encore on pouvait s'en passer :

Sub MonEnteteDocument()
Dim MonLogo As String
Dim oLogo As InlineShape ' on utilise un OBJET de classe InlineShape
MonLogo = C:.....Mes imagesLogo.bmp" ' à modifier
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.ParagraphFormat.TabStops.ClearAll
With Selection
.ParagraphFormat.Alignment = wdAlignParagraphRight
' et voici l'affectation de l' OBJET :
Set oLogo = .InlineShapes.AddPicture(FileName:=MonLogo, _
LinkToFile:úlse, SaveWithDocument:=True)
End With

With oLogo
.Height = 57#
.Width = 69.75
' placez ici d'autre modifications de l'OBJET oLogo
End With

ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Set oLogo = Nothing
End Sub

C'est mieux ?

Anacoluthe
« C'est encore en méditant l'objet
que le sujet a le plus de chance de s'approfondir. »
- Gaston BACHELARD
Avatar
Emile
Anacoluthe m'a écris..


Lors de l'insertion du logo créez un OBJET pour lui
(VBA est un langage à objets !)
vous utiliserez ensuite cet objet pour en modifier ses propriétés
Vous n'avez même pas besoin de le sélectionner !

J'ai gardé le début de votre macro qui sélectionne l'en-tête
mais là encore on pouvait s'en passer :

Sub MonEnteteDocument()
Dim MonLogo As String
Dim oLogo As InlineShape ' on utilise un OBJET de classe InlineShape
MonLogo = C:.....Mes imagesLogo.bmp" ' à modifier
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.ParagraphFormat.TabStops.ClearAll
With Selection
.ParagraphFormat.Alignment = wdAlignParagraphRight
' et voici l'affectation de l' OBJET :
Set oLogo = .InlineShapes.AddPicture(FileName:=MonLogo, _
LinkToFile:úlse, SaveWithDocument:=True)
End With

With oLogo
.Height = 57#
.Width = 69.75
' placez ici d'autre modifications de l'OBJET oLogo
End With

ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Set oLogo = Nothing
End Sub

C'est mieux ?



PARFAIT... :-)
Et je crois même que j' ai compris l'esprit de l'OBJET, ;-) Merci.
Petite questions subsidiaires, (j'en profite..)
Sur ma procédure j'ai beaucoup ramé pour chercher à sélectionner le logo.
C'est donc par curiosité:
-Quelle commande aurais-je du utiliser pour y arriver par ce sinueux chemin?
-Pour modifier objet de ta procédure:
-Comment faire pour ne mettre qu'une dimension, par exemple: 2,0 cm
et que l'autre dimension se réduise proportionnellement en gardant le même
rapport Hauteur / largeur?

Merci d'avance pour ces précisions / curiosités.
Cordialement,
Emile
Avatar
Anacoluthe
Bonjour !

'Emile' nous a écrit ...
Petite questions subsidiaires, (j'en profite..)
Sur ma procédure j'ai beaucoup ramé pour chercher à sélectionner le logo.
C'est donc par curiosité:
-Quelle commande aurais-je du utiliser pour y arriver par ce sinueux chemin?



La méthode (un objet possède des propriétés et des méthodes) est Select
Activedocument.Sections(1).Headers(1).Range.InlineShapes(1).Select
mais il faut savoir quel objet sélectionner ! ici c'est la première
image alignée du premier en-tête de la première section.
D'où l'intérêt d'utiliser une variable objet : oLogo.Select

-Comment faire pour ne mettre qu'une dimension, par exemple: 2,0 cm
et que l'autre dimension se réduise proportionnellement en gardant le même
rapport Hauteur / largeur?



on verrouille l'aspect et on modifie une seule dimension :

With oLogo
.LockAspectRatio = msoTrue
.Height = CentimetersToPoints(2) ' directement en cm avec la conversion
End With

Anacoluthe
« C'est encore en méditant l'objet
que le sujet a le plus de chance de s'approfondir. »
- Gaston BACHELARD
Avatar
Emile
"Anacoluthe"m' a écrit >
La méthode (un objet possède des propriétés et des méthodes) est Select
Activedocument.Sections(1).Headers(1).Range.InlineShapes(1).Select
mais il faut savoir quel objet sélectionner ! ici c'est la première
image alignée du premier en-tête de la première section.
D'où l'intérêt d'utiliser une variable objet : oLogo.Select

-Comment faire pour ne mettre qu'une dimension, par exemple: 2,0 cm
et que l'autre dimension se réduise proportionnellement en gardant le
même rapport Hauteur / largeur?



on verrouille l'aspect et on modifie une seule dimension :

With oLogo
.LockAspectRatio = msoTrue
.Height = CentimetersToPoints(2) ' directement en cm avec la conversion
End With





Merci pour toutes ces précisions, j'apprends toujours de vous ;-))
Avatar
Emile
"Anacoluthe" a écrit >
-Comment faire pour ne mettre qu'une dimension, par exemple: 2,0 cm
et que l'autre dimension se réduise proportionnellement en gardant le
même rapport Hauteur / largeur?



on verrouille l'aspect et on modifie une seule dimension :

With oLogo
.LockAspectRatio = msoTrue
.Height = CentimetersToPoints(2) ' directement en cm avec la conversion
End With



Ca marche pas.. :-((
Je veux dire que le logo se retrouve tout plat :-)))
La commande ne corrige pas automatiquement l'autre dimension
Merci de te sollicitude,
Cordialement
Emile
Avatar
Emile
"Anacoluthe" a écrit .

Activedocument.Sections(1).Headers(1).Range.InlineShapes(1).Select
mais il faut savoir quel objet sélectionner ! ici c'est la première
image alignée du premier en-tête de la première section.



Comment utiliser cette commande pour effacer toutes les images(clearAll)
qui pourraient se retrouver dans cet entête,
si je n'en connais pas le nombre?
Je pense a quelque chose comme ceci (mais bien sûr ça ne marche pas... )
^^^^^^^^^^^^^^^^^^^^^^^^
Activedocument.Sections(1).Headers(1).Range.InlineShapes(All).Select
selection.Delete
ou
Activedocument.Sections(1).Headers(1).Range.InlineShapes.ClearAll
^^^^^^^^^^^^^^^^^^^^^^^^^^
Merci encore pour cette nouvelle contribution.. ;-)

Cordialement
Emile
Avatar
Anacoluthe
Bonjour !

'Emile' nous a écrit ...
Comment utiliser cette commande pour effacer toutes les images(clearAll)
qui pourraient se retrouver dans cet entête,



- VBA n'accepte pas la multisélection d'objets disjoints
- Il n'est pratiquement jamais utile de sélectionner les objets : VBA
ne travaille pas avec une souris et des clics sur un écran :-p
- Une collection d'InlineShapes ne peut être supprimée en bloc.
- Il faut donc supprimer chaque item de la collection un par un :

For Each Image In ActiveDocument.Sections(1).Headers(1).Range.InlineShapes
Image.Delete
Next Image

Anacoluthe
« La vraie question est : pourquoi sélectionner ?
Et je ne connais pas la réponse. »
- Albert JACQUARD
Avatar
Anacoluthe
Bonjour !

'Emile' nous a écrit ...
Ca marche pas.. :-((
Je veux dire que le logo se retrouve tout plat :-)))



Vérifiez que vous n'imposez pas une dimension de 2 points
au lieu de 2 centimètres !

La commande ne corrige pas automatiquement l'autre dimension



Quelle version ? Chez moi ça fonctionne très bien
Remplacez peut-être msoTrue par -1

Anacoluthe
« Ce qui compte c'est se libérer, découvrir ses propres dimensions,
refuser les entraves. »
- Virginia WOOLF
Avatar
Emile
"Anacoluthe" a écrit >

Quelle version ? Chez moi ça fonctionne très bien



Word 2003

Remplacez peut-être msoTrue par -1


Nan.. Pas mieux...




Je vois pas ce qui peut le déranger...
Avatar
Anacoluthe
Bonjour !

'Emile' nous a écrit ...
"Anacoluthe" a écrit >
Quelle version ? Chez moi ça fonctionne très bien


Word 2003
Remplacez peut-être msoTrue par -1


Nan.. Pas mieux...



Ah j'ai trouvé ! Chez moi (WD2007) ce code marche très bien :

' -------------------------------------------------------
Sub MonEnteteDocument()
Dim MonLogo As String
Dim oLogo As InlineShape
With Dialogs(wdDialogInsertPicture)
If .Display = 0 Then: End
MonLogo = .Name
End With
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.ParagraphFormat.TabStops.ClearAll
With Selection
.ParagraphFormat.Alignment = wdAlignParagraphRight
Set oLogo = .InlineShapes.AddPicture(FileName:=MonLogo, _
LinkToFile:úlse, SaveWithDocument:=True)
End With

With oLogo
.LockAspectRatio = msoTrue
.Height = CentimetersToPoints(2)
End With

ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Set oLogo = Nothing
End Sub
' -------------------------------------------------------

(J'ai mis en ligne 4+ une recherche de fichier image plutôt que
votre nom fixe de fichier pour mieux tester)

Mais dans un WD2003 sur un assez vieux PC j'observe aussi
que la largeur n'est pas mise à l'échelle. Ce bug est signalé :
sur les PC lents l'instruction .LockAspectRatio = msoTrue
n'a pas le temps d'être prise en compte !?!
(ça me semble débile mais c'est comme ça ! Les mystères du VBA !)

J'ai donc ajouté une ligne pour forcer la mise à l'échelle :

' -------------------------------------------------------
Sub MonEnteteDocument()
Dim MonLogo As String
Dim oLogo As InlineShape
With Dialogs(wdDialogInsertPicture)
If .Display = 0 Then: End
MonLogo = .Name
End With
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.ParagraphFormat.TabStops.ClearAll
With Selection
.ParagraphFormat.Alignment = wdAlignParagraphRight
Set oLogo = .InlineShapes.AddPicture(FileName:=MonLogo, _
LinkToFile:úlse, SaveWithDocument:=True)
End With

With oLogo
.LockAspectRatio = msoTrue ' cette instruction est parfois ignorée
.Height = CentimetersToPoints(2)
.ScaleWidth = .ScaleHeight ' on force la même échelle
End With

ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Set oLogo = Nothing
End Sub
' -------------------------------------------------------

et là ça marche sur mon vieux (tout est relatif) PC avec WD2003 !

C'est bon ?

Anacoluthe
« Les erreurs sont les portes de la découverte. »
- James JOYCE
1 2