MW211 EXIT

devlog
ExcelVBA/チャート描画
2019年12月18日
四角形で描画するとこんな感じ。
┌──────────────────────────────────────┐
│Sub 描画(ByVal y開始 As Long, _                                             │
│         ByVal x開始 As Long, _                                             │
│         ByVal y終了 As Long, _                                             │
│         ByVal x終了 As Long, _                                             │
│         ByVal 文言 As String)                                              │
│    Dim 図形 As Shape                                                       │
│    With ActiveSheet                                                        │
│        Set 図形 = .Shapes.AddShape( _                                      │
│            msoShapeRectangle, _                                            │
│            .Cells(y開始, x開始).Left, _                                    │
│            .Cells(y開始, x開始).Top, _                                     │
│            .Cells(y終了 + 1, x終了 + 1).Left - .Cells(y開始, x開始).Left, _│
│            .Cells(y終了 + 1, x終了 + 1).Top - .Cells(y開始, x開始).Top _   │
│        )                                                                   │
│    End With                                                                │
│    With 図形                                                               │
│        .Fill.ForeColor.RGB = RGB(255, 255, 255)                            │
│        .Line.ForeColor.RGB = RGB(0, 0, 0)                                  │
│        With .TextFrame2.TextRange.Font                                     │
│            .Size = 9                                                       │
│            .Name = "MS ゴシック"                                         │
│        End With                                                            │
│        With .TextFrame                                                     │
│            .HorizontalAlignment = xlHAlignCenter                           │
│            .VerticalAlignment = xlVAlignCenter                             │
│            .Characters.Font.Color = RGB(0, 0, 0)                           │
│            .Characters.Text = 文言                                         │
│        End With                                                            │
│    End With                                                                │
│End Sub                                                                     │
└──────────────────────────────────────┘

ちなみに、事前に全削除するには以下のような感じ。
┌──────────────────────────────────────┐
│Dim 図形 As Shape                                                           │
│With ActiveSheet                                                            │
│    For Each 図形 In .Shapes                                                │
│        If 図形.Type = msoShapeRectangle Then                               │
│            図形.Delete                                                     │
│        End If                                                              │
│    Next 図形                                                               │
│End With                                                                    │
└──────────────────────────────────────┘
分類:ExcelVBA