Make some margins between borders and image for Rectangle in Excel Application

Make some margins between borders and image for Rectangle in Excel Application

1) Please run the following code in the Excel Application.

    Sub Macro1()
    
    'Delete all shapes if exists
    For i = ActiveSheet.Shapes.Count To 1 Step -1
        ActiveSheet.Shapes(i).Delete
    Next i
    
    'Add a Rectangle
    With ActiveSheet.Shapes.AddShape(Type:=msoShapeRectangle, Left:=20, Top:=20, Width:=200, Height:=120)
        .Name = "myRectangle"
    End With
    
    'Make some formatting to the myRectangle
    With ActiveSheet.Shapes("myRectangle")
       .Line.Visible = msoTrue
       .Line.ForeColor.RGB = vbBlue
       .Line.Weight = 5
       .Fill.UserPicture "https://upload.wikimedia.org/wikipedia/en/b/ba/Flag_of_Germany.svg"
    End With
    
    End Sub

2) Please check if you got the following Rectangle in your Excel Sheet.

Picture1

3) I am looking for a macro which gives me the following picture.

As you can understand that I want to make some margins between borders and flag.

Picture2

Answer

There are many approaches one could try, perhaps the simplest one is to add another, smaller rectangle in the middle of the first one:

Sub Macro1()
    Dim i As Integer
    Dim smallLeft As Double
    Dim smallTop As Double
    Dim smallWidth As Double
    Dim smallHeight As Double
    
    'Delete all shapes if exists
    For i = ActiveSheet.Shapes.Count To 1 Step -1
        ActiveSheet.Shapes(i).Delete
    Next i
    
    'Add a big blue Rectangle
    With ActiveSheet.Shapes.AddShape(Type:=msoShapeRectangle, Left:=20, Top:=20, Width:=200, Height:=120)
        .Name = "myRectangle"
        .Line.Visible = msoTrue
        .Line.ForeColor.RGB = vbBlue
        .Line.Weight = 5
        .Fill.ForeColor.RGB = vbWhite
    End With
    
    'Calculate the dimensions for the small white rectangle (5% smaller)
    smallLeft = 20 + (200 * 0.05)
    smallTop = 20 + (120 * 0.05)
    smallWidth = 200 * 0.9
    smallHeight = 120 * 0.9
    
    'Add the small white Rectangle
    With ActiveSheet.Shapes.AddShape(Type:=msoShapeRectangle, Left:=smallLeft, Top:=smallTop, Width:=smallWidth, Height:=smallHeight)
        .Name = "innerRectangle"
    End With
    
    'Insert the flag inside the small white rectangle
    With ActiveSheet.Shapes("innerRectangle").Fill
        .UserPicture "https://upload.wikimedia.org/wikipedia/en/b/ba/Flag_of_Germany.svg"
    End With
    
End Sub

Enjoyed this article?

Check out more content on our blog or follow us on social media.

Browse more articles