VBAで作る自分用エクセルテンプレート #Windows

はじめに

エクセルをよく使う機会が増えてきて、それに伴い自分好みのテンプレートで作業することが多くなってきた。
一回一回書式設定などするのも面倒なので、VBAで作ってしまって使いまわすことにした。

仕様

自分が使う時はパターン化されている

１列目はタイトル
２列目は何も入れない
３列目に項目
４列目からデータ

それに対してVBAを下記の通り設定する
1. 自分好みの書式（フォント、フォントサイズ、背景色など）を
2. ３列目（項目）に関しては右に入力していく度に自動で背景色を青、文字色を白にして目立たせ、
3. ４列目（データ）からは自動裁判し、
4. データを入力する毎に枠で囲う
5. データや項目など消す時は自動で書式をリセット

完成形イメージ

ソースコード

トリガー

シートの項目やデータに入力があった時に自動で変更されるように宣言する

sheet1

Private Sub Worksheet_Change(ByVal Target As Range)
    ' もしB3以降に文字入力されたら実行
    If (Target.Row >= 3 And Target.Column >= 2) Then
        Call Style(1)
    End If
End Sub

全体書式設定

全体の書式を設定するが、最初の一回しか使わない。

module

' ３列目を基準とする
Public Const BaseRow As Integer = 3


' 今あるシート全体に自分好みの文字や背景色など適用させる
Sub BasicConfig()
    Dim i As Integer
    Dim n As Integer

    n = Worksheets.Count

    ' 全てのシートに対して
    For i = 1 To n
        ' フォント
        Worksheets(i).Cells.Font.Name = "Century Gothic"
        ' フォントサイズ
        Worksheets(i).Cells.Font.Size = 8
        ' 背景色 
        Worksheets(i).Cells.Interior.Color = RGB(255, 255, 255)
        ' 基準の値
        Worksheets(i).Cells(BaseRow, 1).Value = "#"
        ' ボールド
        Worksheets(i).Cells(BaseRow).Font.Bold = True
        ' セルのサイズが自動的に変更になるようにする
        Worksheets(i).Range("A3").CurrentRegion.Columns.AutoFit
        Worksheets(i).Activate
        Range("B4").Select
        ' B4を基準に表示枠を固定する
        ActiveWindow.FreezePanes = True
    Next i
End Sub

トリガーをきっかけに書式を変更する機能

Module

Sub Style(ByVal i As Integer)
    Dim iColumn As Integer
    Dim iRow As Integer
    Dim n As Integer
    Dim Column As Integer
    Dim Row As Integer

    iRow = 1

    ' ３列目の横列に対して入力していけば自動的に書式（セルの色やフォントなど）を設定
    For iColumn = 1 To 100
        ' 何かしら文字が入ったら、背景色青の文字白、ボールド
        If Not Worksheets(i).Cells(BaseRow, iColumn).Value = "" Then
            Worksheets(i).Cells(BaseRow, iColumn).Interior.Color = RGB(83, 141, 213)
            Worksheets(i).Cells(BaseRow, iColumn).Font.Color = RGB(255, 255, 255)
            Worksheets(i).Cells(BaseRow, iColumn).Font.Bold = True
            Column = iColumn
        ' 何も文字入ってなかったら背景色白の文字黒
        Else
            Worksheets(i).Cells(BaseRow, iColumn).Interior.Color = RGB(255, 255, 255)
            Worksheets(i).Cells(BaseRow, iColumn).Font.Color = RGB(0, 0, 0)
            Exit For
        End If
    Next iColumn

    '　４列目のデータを記入していくところの書式設定自動化
    For iRow = BaseRow + 1 To 1000
        If Not Worksheets(i).Cells(iRow, 2).Value = "" Then
            Worksheets(i).Cells(iRow, 1).Value = iRow - BaseRow
            Worksheets(i).Cells(iRow, 1).Interior.Color = RGB(83, 141, 213)
            Worksheets(i).Cells(iRow, 1).Font.Color = RGB(255, 255, 255)
            Worksheets(i).Cells(iRow, 1).Font.Bold = True
            Row = iRow
        Else
            Worksheets(i).Cells(iRow, 1).Value = ""
            Worksheets(i).Cells(iRow, 1).Interior.Color = RGB(255, 255, 255)
            Worksheets(i).Cells(iRow, 1).Font.Color = RGB(0, 0, 0)
            Exit For
        End If
    Next iRow

    '　対象の部分は枠で囲う
    Range(Cells(3, 1), Cells(iRow - 1, iColumn - 1)).Borders.LineStyle = xlContinuous

    '  入力した部分の枠の長さを自動調整
    Range("A3").CurrentRegion.Columns.AutoFit

    '  対象外の部分は枠を削除その１
    For n = iRow To 1000
        If Cells(n, 1).Borders.LineStyle = xlContinuous Then
            Range(Cells(n, 1), Cells(n, iColumn)).Borders.LineStyle = xlLineStyleNone
        Else
            Exit For
        End If
    Next n

    '  対象外の部分は枠を削除その２
    For n = iColumn To 1000
        If Cells(3, n).Borders.LineStyle = xlContinuous Then
            Range(Cells(3, n), Cells(iRow, n)).Borders.LineStyle = xlLineStyleNone
        Else
            Exit For
        End If
    Next n
End Sub

とりあえず即席で作ったので無駄な書き方や好ましくない仕様の部分もあるので、いつかアップデートしたい。