pgbigorokuのブログ

プログラムの再利用できそうなコードをアップ

EXCEL VBA シートの情報を初期化する。2

イメージ

サンプル

Public Sub sample()
    Call nipsubClear2(Worksheets("Sheet1"), 6, 3, 8, 5, True, True)
End Sub

ソースコード

' シートの情報を初期化する。2
'
' ByRef wksTarger As Worksheet 初期化するシートオブジェクト
' Optional ByVal plngStartRow As Long = 1 初期化を開始する行番号
'  Optional ByVal pintStartCol As Integer = 1 初期化を開始する列番号
'  Optional ByVal plngEndRow As Long = 0 初期化を終了する行番号(0の場合は最終行を自動的に探す)
'  Optional ByVal pintEndCol As Integer = 0, _ 初期化を終了する列番号(0の場合は最終列を自動的に探す)
'  Optional ByVal pblnUnMerge As Boolean = True  セル結合を解除する
'  Optional ByVal pblnフォント初期化 As Boolean = True 書式を設定する。(psubClear2_フォント初期化でここに指定)
'
'URL https://pgbigoroku.hatenablog.com/entry/2022/08/15/135816
'必要URL https://pgbigoroku.hatenablog.com/entry/2022/08/14/140613
'バージョン 2022/8/19
Public Sub nipsubClear2(ByRef pwksTarger As Worksheet, _
                            Optional ByVal plngStartRow As Long = 1, _
                            Optional ByVal pintStartCol As Integer = 1, _
                            Optional ByVal plngEndRow As Long = 0, _
                            Optional ByVal pintEndCol As Integer = 0, _
                            Optional ByVal pblnUnMerge As Boolean = True, _
                            Optional ByVal pblnフォント初期化 As Boolean = True)
    Dim lngLastRow As Long
    Dim intLastCol As Integer
    Dim rngClear As Range
    If plngStartRow <= 0 Then
        plngStartRow = 1
    End If
    If pintStartCol <= 0 Then
        pintStartCol = 1
    End If
    If plngEndRow = 0 Then
        lngLastRow = niplngシート全体の最終行を取得(pwksTarger)
    Else
        lngLastRow = plngEndRow
    End If
    If pintEndCol = 0 Then
        intLastCol = nipintシート全体の最終列を取得(pwksTarger)
    Else
        intLastCol = pintEndCol
    End If
    
    If plngStartRow > lngLastRow Then
        '何もしない
    ElseIf pintStartCol > intLastCol Then
        '何もしない
    Else
        With pwksTarger
            Set rngClear = .Range(.Cells(plngStartRow, pintStartCol), .Cells(lngLastRow, intLastCol))
            If pblnUnMerge = True Then
                rngClear.UnMerge
            End If
            rngClear.ClearContents
            If pblnフォント初期化 = True Then
                Call nipsubClear2_フォント初期化(rngClear)
            End If
        End With
    End If
End Sub

' シートの情報を初期化する。2のフォント指定
'
'URL https://pgbigoroku.hatenablog.com/entry/2022/08/15/135816
'バージョン 2022/8/5
Public Sub nipsubClear2_フォント初期化(ByRef prngTarget As Range)
    Dim wksBefore As Worksheet
    Set wksBefore = ActiveSheet
    
    prngTarget.Parent.Parent.Activate
    prngTarget.Parent.Select
    prngTarget.Select
    
    '---------------- この下にお好きなフォントなどを指定する。
    
    
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    '---------------- ここまでお好きなフォントなどを指定する。
    wksBefore.Parent.Activate
    wksBefore.Select
End Sub

'シート全体の最終行を取得
'
'引数
'   ByRef sht対象 As Worksheet 対象のシート
'URL https://pgbigoroku.hatenablog.com/entry/2022/08/14/140613
'
'バージョン 2022/8/14
Public Function niplngシート全体の最終行を取得(ByRef sht対象 As Worksheet) As Long
    With sht対象
        niplngシート全体の最終行を取得 = .UsedRange.Rows.Count - .UsedRange.Row + 1
    End With
End Function


'pintシート全体の最終列を取得
'
'引数
'   ByRef sht対象 As Worksheet 対象のシート
'
'URL https://pgbigoroku.hatenablog.com/entry/2022/08/14/140613
'
'バージョン 2022/8/14
Public Function nipintシート全体の最終列を取得(ByRef sht対象 As Worksheet) As Integer
    With sht対象
        nipintシート全体の最終列を取得 = .UsedRange.Columns.Count - .UsedRange.Column + 1
    End With
End Function