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

2 réponses

1 2
Avatar
Emile
"Anacoluthe" a écrit > > 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 ?




OUI... ;-) PARFAIT!

Question: A quoi sert le : Set oLogo = Nothing
Puisque la macro est terminée...

Encore merci pour ton aide.

Cordialement,

Emile
Avatar
Anacoluthe
Bonjour !

'Emile' nous a écrit ...
OUI... ;-) PARFAIT!
Question: A quoi sert le : Set oLogo = Nothing



à rien ! :-)

C'est plus propre : on libère l'allocation mémoire de l'objet

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