┌──────────────────────────────────────┐
│Sub 矩形図形の重なりを着色()                                                │
│    '-----------------------------------------------------------------------│
│    '  一旦クリア                                                           │
│    '-----------------------------------------------------------------------│
│    Dim 図形 As Shape                                                       │
│    With ActiveSheet                                                        │
│        For Each 図形 In .Shapes                                            │
│            If 図形.Type = msoShapeRectangle Then                           │
│                図形.Fill.ForeColor.RGB = RGB(255, 255, 255)                │
│            End If                                                          │
│        Next 図形                                                           │
│    End With                                                                │
│    '-----------------------------------------------------------------------│
│    '  重なりを着色                                                         │
│    '-----------------------------------------------------------------------│
│    Dim 図形1 As Shape, 図形2 As Shape                                      │
│    Dim i1 As Long, i2 As Long                                              │
│    With ActiveSheet                                                        │
│        For i1 = 1 To .Shapes.Count                                         │
│            If .Shapes(i1).Type = msoShapeRectangle Then                    │
│                Set 図形1 = .Shapes(i1)                                     │
│                For i2 = i1 + 1 To .Shapes.Count                            │
│                    If .Shapes(i2).Type = msoShapeRectangle Then            │
│                        Set 図形2 = .Shapes(i2)                             │
│                        If is重層(図形1.Top, _                              │
│                                  図形1.Top + 図形1.Height, _               │
│                                  図形1.Left, _                             │
│                                  図形1.Left + 図形1.Width, _               │
│                                  図形2.Top, _                              │
│                                  図形2.Top + 図形2.Height, _               │
│                                  図形2.Left, _                             │
│                                  図形2.Left + 図形2.Width) Then            │
│                            図形1.Fill.ForeColor.RGB = RGB(255, 0, 0)       │
│                            図形2.Fill.ForeColor.RGB = RGB(255, 0, 0)       │
│                        End If                                              │
│                    End If                                                  │
│                Next i2                                                     │
│            End If                                                          │
│        Next i1                                                             │
│    End With                                                                │
│End Sub                                                                     │
├──────────────────────────────────────┤
│Private Function is重層( _                                                  │
│    ByVal 上1 As Single, ByVal 下1 As Single, _                             │
│    ByVal 左1 As Single, ByVal 右1 As Single, _                             │
│    ByVal 上2 As Single, ByVal 下2 As Single, _                             │
│    ByVal 左2 As Single, ByVal 右2 As Single _                              │
│) As Boolean                                                                │
│    is重層 = IIf(左1 < 右2 And 左2 < 右1 And 上1 < 下2 And 上2 < 下1, _     │
│                 True, _                                                    │
│                 False)                                                     │
│End Function                                                                │
└──────────────────────────────────────┘