Создать форму с отверстием в Excel VBA

Question

Как создать форму с отверстием в Excel VBA?

Private Sub test_freeform() 
     Dim ws As Worksheet 
     Set ws = ActiveSheet 
     With ws.Shapes.BuildFreeform(msoEditingAuto, 20, 20) ' returns FreeFormBuilder 
     .AddNodes msoSegmentLine, msoEditingAuto, 100, 20 
     .AddNodes msoSegmentLine, msoEditingAuto, 100, 100 
     .AddNodes msoSegmentLine, msoEditingAuto, 20, 100 
     .AddNodes msoSegmentLine, msoEditingAuto, 20, 20 
     .AddNodes msoSegmentLine, msoEditingAuto, 30, 30 

     .AddNodes msoSegmentLine, msoEditingAuto, 30, 60 
     .AddNodes msoSegmentLine, msoEditingAuto, 60, 60 
     .AddNodes msoSegmentLine, msoEditingAuto, 60, 30 
     .AddNodes msoSegmentLine, msoEditingAuto, 30, 30 

     .AddNodes msoSegmentLine, msoEditingAuto, 20, 20 
     .ConvertToShape 
     End With 
    End Sub 

Это создает форму с сегментом, который соединяет верхний левый угол внешнего прямоугольника с верхним левым углом отверстия. Я хочу как-то избавиться от этого сегмента. Некоторые из предопределенных форм Excel имеют в них правильные отверстия, поэтому я знаю, что такая форма может существовать.

Answer 1

Может быть, это поможет вам, это своего рода обходной путь:

испытано и работа в Excel 2003

Отредактированный код: сохранил только прямоугольник

Private Sub test_freeform() 
    Dim ws As Worksheet 
    Set ws = ActiveSheet 

    Dim rectShp As Shape 
    With ws.Shapes.BuildFreeform(msoEditingAuto, 20, 20) ' returns FreeFormBuilder 
     .AddNodes msoSegmentLine, msoEditingAuto, 100, 20 
     .AddNodes msoSegmentLine, msoEditingAuto, 100, 100 
     .AddNodes msoSegmentLine, msoEditingAuto, 20, 100 
     .AddNodes msoSegmentLine, msoEditingAuto, 20, 20 

     Set rectShp = .ConvertToShape 
    End With 

    Dim bRed As Byte, bGreen As Byte, bBlue As Byte 
    bRed = 255: bGreen = 0: bBlue = 0 

    Dim cirShp As Shape 
    Set cirShp = ws.Shapes.AddShape(msoShapeOval, 50, 40, 20, 20) 

    With cirShp.Fill 
     .Solid 
     .ForeColor.RGB = RGB(bRed, bGreen, bBlue) 
     Dim holeColor As Long 
     holeColor = .ForeColor.RGB 
    End With 

    cirShp.Line.ForeColor.RGB = rectShp.Line.ForeColor.RGB 

    Dim grouped As Shape 
    Set grouped = ws.Shapes.Range(Array(rectShp.Name, cirShp.Name)).Group 

    grouped.Copy 
    Dim imgShp As Shape 
    ws.PasteSpecial Format:="Image (GIF)" 
    grouped.Delete 
    Set imgShp = ws.Shapes(1) 

    imgShp.PictureFormat.TransparencyColor = holeColor 
    imgShp.PictureFormat.TransparentBackground = msoTrue 

End Sub 

Редактировать: Добавлено:

Вот что это выглядит как в 2003 году, поэтому я думал, что это было достаточно хорошо;)