Sub Macro4()
Dim appWord As Object, docWord As Object, rectangle As Object, fichierImg As String
'créer une instance de word
Set appWord = CreateObject("Word.Application")
'rendre l'application Word visible (mettre false pour la cacher)
appWord.Visible = True
'ouvrir le document Word (celui à modifier)
Set docWord = appWord.Documents.Open("E:\Doc1.doc")
'récupérer le rectangle ("Rectangle 42") du document Word
Set rectangle = docWord.Shapes("Rectangle 42")
'effectuer l'ensemble des opérations sur ce rectangle
With rectangle
.Fill.Transparency = 0#
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.RGB = RGB(0, 0, 0)
.Line.BackColor.RGB = RGB(255, 255, 255)
.LockAspectRatio = msoFalse
.Rotation = 0#
.Left = 159#
.Top = 291.1
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Fill.BackColor.RGB = RGB(255, 255, 255)
ChoixFichier:
fichierImg = Application.GetOpenFilename("Fichier Image, *.jpeg;*.jpg;*.gif;*.bmp;*.png", , "Image à insérer :")
If fichierImg = "Faux" Then
If MsgBox("Aucune image n'est sélectionnée." & vbNewLine & "Voulez-vous sélectionner une autre image ?", vbYesNo, "Erreur") = vbYes Then GoTo ChoixFichier
Else
.Fill.UserPicture fichierImg
End If
.RelativeHorizontalPosition = 2
.RelativeVerticalPosition = 2
.RelativeHorizontalSize = 1
.RelativeVerticalSize = 1
.Left = appWord.CentimetersToPoints(3.61)
.LeftRelative = -999999
.Top = appWord.CentimetersToPoints(0.17)
.TopRelative = -999999
.WidthRelative = -999999
.HeightRelative = -999999
.LockAnchor = False
.LayoutInCell = True
.WrapFormat.AllowOverlap = True
.WrapFormat.Side = 0
.WrapFormat.DistanceTop = appWord.CentimetersToPoints(0)
.WrapFormat.DistanceBottom = appWord.CentimetersToPoints(0)
.WrapFormat.DistanceLeft = appWord.CentimetersToPoints(0.32)
.WrapFormat.DistanceRight = appWord.CentimetersToPoints(0.32)
.WrapFormat.Type = 4
End With
End Sub