EXCEL 2010, rajouter une bordure en VBA

Question

Bonjour, 

J'ai une macro qui marche très bien pour télécharger des images à des endroits prédéfinis. J'aimerais cependant pouvoir en même temps insérer une bordure grise (gris moyen, épaisseur du trait 0.25) et c'est là que mes connaissances s'arrêtent !
Est-ce que quelqu'un peut m'aider à ajouter cette fonctionnalité ?

Je mets le code ci-dessous:

Option Explicit
Dim pos As String

Sub InsererImage()
 Dim myPicture As String, MyRange As Range
 myPicture = Application.GetOpenFilename _
 ("Pictures (.bmp; .gif; .jpg; .png; .tif),.bmp; .gif; .jpg; .png; .tif", _
 , "Select Picture to Import")
Set MyRange = Selection
InsertAndSizePic MyRange, myPicture
 With ActiveSheet.Range(pos)
   With Selection.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
   End With
End Sub
Sub InsertAndSizePic(Target As Range, PicPath As String)
Dim p As Picture
 Application.ScreenUpdating = False
On Error GoTo EndOfSubroutine:
 Set p = ActiveSheet.Pictures.Insert(PicPath)
If Target.Cells.Count = 1 Then Set Target = Target.MergeArea
pos = Target.Address
With Target
        p.Top = .Top
        p.Left = .Left
        p.Width = .Width
        p.Height = .Height
    End With
EndOfSubroutine:
End Sub

pilas31 · Answer

Bonjour,

Voila une solution qui semble fonctionner :

...
Set p = ActiveSheet.Pictures.Insert(PicPath)
With p.ShapeRange.Line
    .Visible = msoTrue
    .Weight = 0.25
    .ForeColor.ObjectThemeColor = msoThemeColorBackground1
    .ForeColor.Brightness = -0.25
End With
If Target.Cells.Count = 1 Then Set Target = Target.MergeArea
...
 
  donc insérer dans Sub InsertAndSizePic

plus simple encore en jouant avec RGB on peut avoir les nuances de gris

With p.ShapeRange.Line
    .Visible = msoTrue
    .Weight = 0.25
    .ForeColor.RGB = RGB(150, 150, 150)
End With



A+
Cordialement,

EXCEL 2010, rajouter une bordure en VBA

1 réponse

Votre réponse

Newsletters