Attribute VB_Name = "ModTree"
'''
''' ツリー構造の折りたたみや展開を実現する
'''
''' [example]
''' Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'''   Cancel = Tree.Wrap(Target)
''' End Sub
'''

' 折りたたみ走査行数
Private Const MAXSEEK_BOTTOM = 30
' 折りたたみ走査列数
Private Const MAXSEEK_RIGHT = 100
' マーク：展開
Private Const MARK_OPEN = "◆"
' マーク：折りたたみ
Private Const MARK_CLOSE = "▼"

''' <summary>
'''   指定されたセルを基準にしてツリー構造の折りたたみや展開を実現する
''' </summary>
''' <param name="Target">該当セル</param>
''' <returns>
'''   true  折りたたみや展開処理が完了
'''   false 指定されたセルは不正である
''' </returns>
Public Function Wrap(Target As Range) As Boolean
  Dim r As Long
  
  Application.ScreenUpdating = False
  
  '折りたたみ／展開処理
  i = 0
  For r = Target.Row + 1 To Rows.Count
    If MAXSEEK_BOTTOM < r - Target.Row Then
      Exit For
    End If
    
    If Not canNext(r, Target.Column) Then
      Exit For
    End If
    
    Select Case Target.Value
    Case MARK_OPEN
      Cells(r, Target.Column).EntireRow.Hidden = True
    Case MARK_CLOSE
      If canOpen(r, Target.Column, Target.Row) Then
        Cells(r, Target.Column).EntireRow.Hidden = False
      End If
    End Select
  Next
  
  Application.ScreenUpdating = True
  
  '事後処理
  Select Case Target.Text
  Case MARK_OPEN
    Target.Value = MARK_CLOSE
    Wrap = True
  Case MARK_CLOSE
    Target.Value = MARK_OPEN
    Wrap = True
  Case Else
    Wrap = False
  End Select

End Function

''' <summary>
''' 指定されたセルに対して処理を継続するかどうかを取得する
''' </summary>
''' <param name="r">該当セルの行</param>
''' <param name="c">該当セルの列</param>
''' <returns>true:継続,false:終了</returns>
Private Function canNext(r As Long, c As Long) As Boolean
  Dim col As Long
  
  'その行の最初の列について調べる
  If Not Cells(r, c + 1).Value = "" And _
     Not Cells(r, c + 1).Value = MARK_CLOSE And _
     Not Cells(r, c + 1).Value = MARK_OPEN Then
    canNext = False
    Exit Function
  End If
  
  'この行の左列について調べる
  For col = 1 To c
    If Not Cells(r, col).Value = "" Then
      canNext = False
      Exit Function
    End If
  Next
  
  canNext = True
End Function

''' <summary>
''' 展開時に指定されたセルの行を展開するかどうかを取得する
''' </summary>
''' <param name="r">該当セルの行</param>
''' <param name="c">該当セルの列</param>
''' <returns>
'''   true  展開する
'''   false 展開しない
''' </returns>
Private Function canOpen(r As Long, c As Long, begin_row As Long) As Boolean
  Dim rr As Long
  
  'その行の最初の列についてだけ調べる
  If c = Columns.Count Then
    canOpen = True
    Exit Function
  ElseIf Not Cells(r, c + 1).Value = "" Then
    canOpen = True
    Exit Function
  End If
  
  'ループで前行に戻りつつ、再帰で右列を調べる
  For rr = r - 1 To begin_row + 1 Step -1
    If Cells(rr, c + 1).Value = MARK_CLOSE Then
      canOpen = False
      Exit Function
    ElseIf Not Cells(rr, c + 1).Value = "" Then
      'この階層ではわからないのでひとつ右の列を調べる
      canOpen = canOpen(r, c + 1, begin_row)
      Exit Function
    End If
  Next
  
  'この階層ではわからないのでひとつ右の列を調べる
  If c <= MAXSEEK_RIGHT Then
    canOpen = canOpen(r, c + 1, begin_row)
  Else
    canOpen = True
  End If

End Function