Início / coding / Perguntas / 79565473
Accepted
Danny Coleiro
Asked: 2025-04-10 07:14:55 +0800 CST

Crie algumas margens entre bordas e imagem para retângulo no aplicativo Excel

  • 772

1) Execute o seguinte código no aplicativo Excel .

    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) Verifique se você obteve o seguinte retângulo em sua planilha do Excel .

Imagem 1

3) Estou procurando uma macro que me dê a seguinte imagem.

Como você pode entender, eu quero fazer algumas margens entre as bordas e a bandeira .

Imagem 2

excel

2 respostas

  1. Best Answer

    Por favor, tente .PictureFormat.Cropobter o resultado esperado.

    Documentação da Microsoft:

    Propriedade PictureFormat.Crop (Word)

    Sub Macro1()
    Dim i
    '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"
        
        With .PictureFormat.Crop
            Dim iW: iW = .PictureWidth
            Dim iH: iH = .PictureHeight
            Const OFFSET_PCT = 0.05  ' Modify as needed
            .PictureWidth = iW * (1 - 2 * OFFSET_PCT)
            .PictureHeight = iH * (1 - 2 * OFFSET_PCT * iW / iH)
        End With
    End With
    
End Sub

    insira a descrição da imagem aqui

    • 2

  2. Há muitas abordagens que você pode tentar, talvez a mais simples seja adicionar outro retângulo menor no meio do primeiro:

    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
    • 1

relate perguntas