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

Le
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 SettingsAdministrateurMes documentsMes
imagesLogo.bmp"
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.ParagraphFormat.TabStops.ClearAll
With Selection
.ParagraphFormat.Alignment = wdAlignParagraphRight
.InlineShapes.AddPicture FileName:=MonLogo, _
LinkToFile:úlse, 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
Questions / Réponses high-tech
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Anacoluthe
Le #17634171
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
Emile
Le #17634911
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
Anacoluthe
Le #17635361
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
Emile
Le #17638111
"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 ;-))
Emile
Le #17638281
"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
Emile
Le #17638431
"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
Anacoluthe
Le #17639891
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
Anacoluthe
Le #17639881
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
Emile
Le #17640171
"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...
Anacoluthe
Le #17641351
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
Publicité
Poster une réponse
Anonyme