Excel VBA：ワークシートを便利に操作させてくれるクラス

Excel VBA

2020.07.21 2020.07.13

サンプルコード

Option Explicit

Public Function GetSheet(ByVal sheet_name As String) As Worksheet

    Set GetSheet = ThisWorkbook.Worksheets(sheet_name)
End Function

Public Function SheetExists(ByVal sheet_name As String, Optional ByVal result As Boolean = False) As Boolean

    Dim w As Worksheet
    
    For Each w In ThisWorkbook.Worksheets
    
        If w.Name = sheet_name Then
        
            result = True
            Exit For
        End If
    Next w
    
    SheetExists = result
End Function

Public Function AddSheet(ByVal sheet_name As String, Optional ByVal result As Boolean = True) As Boolean

    On Error GoTo ErrorHandler
    
    ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)).Name = sheet_name
    
Finally:

    AddSheet = result
    Exit Function
    
ErrorHandler:

    result = False
    Call ShowError(Err)
    GoTo Finally
End Function

Public Function DeleteSheet(ByVal sheet_name As String, Optional ByVal result As Boolean = True) As Boolean

    On Error GoTo ErrorHandler
    
    GetSheet(sheet_name).Delete
    
Finally:

    DeleteSheet = result
    Exit Function
    
ErrorHandler:

    result = False
    Call ShowError(Err)
    GoTo Finally
End Function

Public Function GetLastRow(ByVal sheet_name As String, ByVal column_number As Long) As Long

    GetLastRow = GetSheet(sheet_name).Cells(Rows.Count, column_number).End(xlUp).Row
End Function

Public Sub ChangeDefaultTableLayout(ByVal sheet_name As String, ByVal last_column_number As Long)

    Dim target_sheet As Worksheet
    Set target_sheet = GetSheet(sheet_name)
    
    Dim last_row_number As Long
    last_row_number = target_sheet.Cells(Rows.Count, last_column_number).End(xlUp).Row
    
    Dim target_range As Range
    Set target_range = Range(target_sheet.Cells(1, 1), target_sheet.Cells(last_row_number, last_column_number))
    
    target_range.Font.Name = "ＭＳ 明朝"
    target_range.Font.Size = 10
    Range(target_sheet.Cells(1, 1), target_sheet.Cells(1, last_column_number)).Interior.Color = RGB(252, 213, 180)
    target_range.Borders.LineStyle = xlDot
    target_range.EntireColumn.AutoFit
    
    Set target_range = Nothing
    Set target_sheet = Nothing
End Sub

Public Sub ShowError(ByVal e As ErrObject)

    Dim s As String
    
    s = ""
    s = s & "ErrorNumber：" & CStr(e.Number) & ";" & vbCrLf
    s = s & "ErrorDescription：" & e.Description & ";" & vbCrLf
    s = s & "ErrorHelpFile：" & e.HelpFile & ";" & vbCrLf
    s = s & "ErrorHelpContext：" & e.HelpContext & ";"
    MsgBox s
End Sub

SheetMeddlerと名付けて使用しているクラス。意外と出番のあるクラス。