엑셀 목차 만들기 자동화, CreateTOC 함수 사용법

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'■ SortArray 명령문
'■ 배열을 오름차순/내림차순으로 정렬합니다.
'■ 인수 설명
'_____________vaArr       : 정렬할 배열입니다.
'_____________SortOrder     : 정렬방향입니다. (오름차순,내림차순)
'_____________NumericSort   : 숫자크기로 정렬할 여부를 결정합니다.(기본값 False, 텍스트형식 정렬)
'■ 반환값
'_____________정렬된 배열을 반환합니다.
'###############################################################
 
Function SortArray(vaArr As Variant, Optional SortOrder As XlSortOrder = xlAscending, Optional NumericSort As Boolean = True)
 
Dim i As Long: Dim j As Long
Dim vaVal As Variant
Dim Temp
 
If NumericSort = True Then
    For Each vaVal In vaArr
        If IsNumeric(vaVal) = False Then NumericSort = False: Exit For
    Next
End If
 
If NumericSort = False Then
    If SortOrder = xlAscending Then
        For i = LBound(vaArr) To UBound(vaArr) - 1
            For j = i + 1 To UBound(vaArr)
                If UCase(vaArr(i)) > UCase(vaArr(j)) Then
                    Temp = vaArr(j)
                    vaArr(j) = vaArr(i)
                    vaArr(i) = Temp
                End If
            Next j
        Next i
    Else
        For i = LBound(vaArr) To UBound(vaArr) - 1
            For j = i + 1 To UBound(vaArr)
                If UCase(vaArr(i)) < UCase(vaArr(j)) Then Temp = vaArr(j) vaArr(j) = vaArr(i) vaArr(i) = Temp End If Next j Next i End If Else If SortOrder = xlAscending Then For i = LBound(vaArr) To UBound(vaArr) - 1 For j = i + 1 To UBound(vaArr) If vaArr(i) > vaArr(j) Then
                    Temp = vaArr(j)
                    vaArr(j) = vaArr(i)
                    vaArr(i) = Temp
                End If
            Next j
        Next i
    Else
        For i = LBound(vaArr) To UBound(vaArr) - 1
            For j = i + 1 To UBound(vaArr)
                If vaArr(i) < vaArr(j) Then
                    Temp = vaArr(j)
                    vaArr(j) = vaArr(i)
                    vaArr(i) = Temp
                End If
            Next j
        Next i
    End If
End If
 
SortArray = vaArr
 
End Function

Sub CreateTOC(Optional SortByLength As Variant = "", Optional SortOrder As Long = 0, Optional returnBtn As Boolean = False, Optional BtnCell As String = "A1")
 
Dim WB As Workbook: Dim WS As Worksheet: Dim tocWS As Worksheet
Dim vaArr As Variant
Dim i As Long: Dim x As Long: Dim j As Long: Dim jj As Long: x = 0: j = 0: jj = 1
Dim groupLen As Variant: Dim prefix As String: groupLen = 0
 
Application.ScreenUpdating = False
 
Set WB = ActiveWorkbook
Set tocWS = WB.Worksheets.Add(Before:=WB.Worksheets(1))
 
'임시 배열 생성
ReDim vaArr(0 To WB.Worksheets.Count - 2)
For i = 2 To WB.Worksheets.Count
    vaArr(i - 2) = WB.Worksheets(i).Name
Next
 
If SortOrder = 1 Then vaArr = SortArray(vaArr, xlAscending)
If SortOrder = -1 Then vaArr = SortArray(vaArr, xlDescending)
 
tocWS.Activate
ActiveWindow.DisplayGridlines = False
 
With tocWS
    On Error GoTo shtexist
    .Name = "목차"
resume_1:
    .Tab.Color = RGB(47, 47, 47)
    .Range("A:B").EntireColumn.ColumnWidth = 4
    .Range("4:500").EntireRow.RowHeight = 20
    .Range("2:2").Interior.Color = RGB(47, 47, 47)
    .Range("1:1").EntireRow.RowHeight = 11
 
    With .Range("B2")
        .value = "목차"
        .Font.Bold = True
        .Font.Size = 18
        .Font.Color = RGB(255, 255, 255)
    End With
 
    .Range("B4").value = "#"
    .Range("C4").value = "시트명"
    With .Range("B4").EntireRow
        .Font.Bold = True
        .Font.Color = RGB(255, 255, 255)
        .Interior.Color = RGB(89, 89, 89)
    End With
 
    For i = LBound(vaArr) To UBound(vaArr)
 
        If IsNumeric(SortByLength) = True Then
            groupLen = SortByLength
        Else
            If InStr(1, vaArr(i), SortByLength) > 0 Then groupLen = InStr(1, vaArr(i), SortByLength) - 1
        End If
        On Error Resume Next
        If Left(vaArr(i - 1), groupLen) <> Left(vaArr(i), groupLen) Then
 
            If (i = LBound(vaArr) And SortOrder = 0) Then
                j = j + 1: jj = 1
            Else
                j = j + 1: jj = 1
                .Cells(x + 5, 2).value = j
                .Cells(x + 5, 3).value = Left(vaArr(i), groupLen)
                If .Cells(x + 5, 3).value = "" Then .Cells(x + 5, 3).value = "기타항목"
                .Cells(x + 5, 2).NumberFormat = "0*."
                .Cells(x + 5, 1).EntireRow.Font.Bold = True
                .Cells(x + 5, 1).EntireRow.Interior.Color = RGB(245, 245, 245)
                x = x + 1
            End If
            On Error GoTo 0
        Else
            jj = jj + 1
        End If
 
        If blnSort = True Then prefix = "'" & j & "-"
 
        .Cells(x + 5, 2).value = prefix & jj
        .Cells(x + 5, 2).NumberFormat = "_~@"
        .Hyperlinks.Add anchor:=.Cells(x + 5, 3), Address:="", SubAddress:="'" & CStr(vaArr(i)) & "'!A1", TextToDisplay:=vaArr(i)
        .Cells(x + 5, 3).InsertIndent 1
 
        x = x + 1
    Next
 
    .Range("C:C").EntireColumn.AutoFit
 
End With
 
If returnBtn = True Then
    For i = 2 To WB.Worksheets.Count
        WB.Worksheets(i).Hyperlinks.Add anchor:=WB.Worksheets(i).Range(BtnCell), Address:="", SubAddress:=tocWS.Name & "!A1", TextToDisplay:="목차로 돌아가기"
        WB.Worksheets(i).Range(BtnCell).Font.Bold = True
    Next
End If
 
Application.ScreenUpdating = True
 
Exit Sub
 
shtexist:
    tocWS.Name = "목차" & Format(Now, "yyyymmddhhmmss")
    On Error GoTo 0
    Resume resume_1
 
End Sub