セル装飾関数

VBA セル

使い方（マニュアル）

1. 関数の説明

Call SetCellAttributes(targetCell, borderSettings, bgColor, fontColor, cellValue)

引数	説明
targetCell	対象のセル（例: Range(“A1”)）
borderSettings	上下左右の枠線情報を格納した配列（枠線の有無, 太さ, 線種）
bgColor	背景色 (RGB(255,255,0) など)
fontColor	文字色 (RGB(0,0,0) など)
cellValue	設定する内容

戻り値は、上下左右の枠線情報 + 背景色 + 文字色 + 内容を含む配列。

2. borderSettings の配列の構造

vba
コピーする
編集する
borderSettings(ｲﾝﾃﾞｯｸｽ:0 To 3, 0 To 2)

ｲﾝﾃﾞｯｸｽ	内容	例
0	上枠線	(xlEdgeTop)
1	下枠線	(xlEdgeBottom)
2	左枠線	(xlEdgeLeft)
3	右枠線	(xlEdgeRight)

各インデックスには、以下の 3 つの情報を格納：

枠線の有無	(True / False / Empty)
枠線の太さ	(xlThin など)
枠線の線種	(xlContinuous など)

Function SetCellAttributes(targetCell As Range, borderSettings As Variant, bgColor As Variant, fontColor As Variant, cellValue As Variant) As Variant
    Dim result(1 To 4, 1 To 4) As Variant ' 上下左右の枠線情報を格納
    
    Dim borderPositions As Variant
    borderPositions = Array(xlEdgeTop, xlEdgeBottom, xlEdgeLeft, xlEdgeRight) ' 上下左右の枠線
    
    Dim i As Integer
    For i = 0 To 3
        If Not IsEmpty(borderSettings(i, 0)) Then ' 枠線の有無を指定
            If borderSettings(i, 0) = True Then
                With targetCell.Borders(borderPositions(i))
                    .LineStyle = borderSettings(i, 2) ' 線種
                    .Weight = borderSettings(i, 1) ' 太さ
                End With
                result(i + 1, 1) = "あり"
                result(i + 1, 2) = borderSettings(i, 1)
                result(i + 1, 3) = borderSettings(i, 2)
            Else
                targetCell.Borders(borderPositions(i)).LineStyle = xlNone ' 枠線なし
                result(i + 1, 1) = "なし"
                result(i + 1, 2) = ""
                result(i + 1, 3) = ""
            End If
        Else
            ' 指定なし（現状維持）
            result(i + 1, 1) = "現状のまま"
            result(i + 1, 2) = ""
            result(i + 1, 3) = ""
        End If
    Next i

    ' 背景色の設定
    If Not IsEmpty(bgColor) Then
        targetCell.Interior.Color = bgColor
    End If
    result(1, 4) = "背景色: " & IIf(IsEmpty(bgColor), "現状のまま", bgColor)

    ' 文字色の設定
    If Not IsEmpty(fontColor) Then
        targetCell.Font.Color = fontColor
    End If
    result(2, 4) = "文字色: " & IIf(IsEmpty(fontColor), "現状のまま", fontColor)

    ' 内容の設定
    If Not IsEmpty(cellValue) Then
        targetCell.Value = cellValue
    End If
    result(3, 4) = "内容: " & IIf(IsEmpty(cellValue), "現状のまま", cellValue)

    ' 戻り値として設定情報の配列を返す
    SetCellAttributes = result
End Function

0001 Function SetCellAttributes(targetCell As Range, borderSettings As Variant, bgColor As Variant, fontColor As Variant, cellValue As Variant) As Variant
0002 Dim result(1 To 4, 1 To 4) As Variant ' 上下左右の枠線情報を格納
0003 
0004 Dim borderPositions As Variant
0005 borderPositions = Array(xlEdgeTop, xlEdgeBottom, xlEdgeLeft, xlEdgeRight) ' 上下左右の枠線
0006 
0007 Dim i As Integer
0008 For i = 0 To 3
0009 If Not IsEmpty(borderSettings(i, 0)) Then ' 枠線の有無を指定
0010 If borderSettings(i, 0) = True Then
0011 With targetCell.Borders(borderPositions(i))
0012 .LineStyle = borderSettings(i, 2) ' 線種
0013 .Weight = borderSettings(i, 1) ' 太さ
0014 End With
0015 result(i + 1, 1) = "あり"
0016 result(i + 1, 2) = borderSettings(i, 1)
0017 result(i + 1, 3) = borderSettings(i, 2)
0018 Else
0019 targetCell.Borders(borderPositions(i)).LineStyle = xlNone ' 枠線なし
0020 result(i + 1, 1) = "なし"
0021 result(i + 1, 2) = ""
0022 result(i + 1, 3) = ""
0023 End If
0024 Else
0025 ' 指定なし（現状維持）
0026 result(i + 1, 1) = "現状のまま"
0027 result(i + 1, 2) = ""
0028 result(i + 1, 3) = ""
0029 End If
0030 Next i
0031 
0032 ' 背景色の設定
0033 If Not IsEmpty(bgColor) Then
0034 targetCell.Interior.Color = bgColor
0035 End If
0036 result(1, 4) = "背景色: " & IIf(IsEmpty(bgColor), "現状のまま", bgColor)
0037 
0038 ' 文字色の設定
0039 If Not IsEmpty(fontColor) Then
0040 targetCell.Font.Color = fontColor
0041 End If
0042 result(2, 4) = "文字色: " & IIf(IsEmpty(fontColor), "現状のまま", fontColor)
0043 
0044 ' 内容の設定
0045 If Not IsEmpty(cellValue) Then
0046 targetCell.Value = cellValue
0047 End If
0048 result(3, 4) = "内容: " & IIf(IsEmpty(cellValue), "現状のまま", cellValue)
0049 
0050 ' 戻り値として設定情報の配列を返す
0051 SetCellAttributes = result
0052 End Function

'呼び出し例
Sub TestSetCellAttributes()
    Dim cell As Range
    Set cell = Range("B2") ' 対象セル

    Dim borderSettings(0 To 3, 0 To 2) As Variant

    ' 上枠線あり、太さ=xlThick、線種=xlContinuous
    borderSettings(0, 0) = True
    borderSettings(0, 1) = xlThick
    borderSettings(0, 2) = xlContinuous

    ' 下枠線なし
    borderSettings(1, 0) = False
    borderSettings(1, 1) = ""
    borderSettings(1, 2) = ""

    ' 左枠線の指定なし（現状維持）
    borderSettings(2, 0) = Empty
    borderSettings(2, 1) = ""
    borderSettings(2, 2) = ""

    ' 右枠線あり、太さ=xlMedium、線種=xlDash
    borderSettings(3, 0) = True
    borderSettings(3, 1) = xlMedium
    borderSettings(3, 2) = xlDash
    ' 背景色を黄色
    Dim bgColor As Variant
    bgColor = RGB(255, 255, 0)
    ' 文字色を赤
    Dim fontColor As Variant
    fontColor = RGB(255, 0, 0)
    ' セルの内容を「テスト」
    Dim cellValue As Variant
    cellValue = "テスト"

    ' 関数実行
    Dim result As Variant
    result = SetCellAttributes(cell, borderSettings, bgColor, fontColor, cellValue)

    ' 設定内容を表示
    Dim i As Integer
    Dim output As String
    output = "枠線情報:" & vbCrLf
    For i = 1 To 4
        output = output & "枠線 " & i & ": " & result(i, 1) & ", 太さ: " & result(i, 2) & ", 線種: " & result(i, 3) & vbCrLf
    Next i
    output = output & vbCrLf & result(1, 4) & vbCrLf & result(2, 4) & vbCrLf & result(3, 4)
    MsgBox output, vbInformation, "セル設定情報"
End Sub

0001 '呼び出し例
0002 Sub TestSetCellAttributes()
0003 Dim cell As Range
0004 Set cell = Range("B2") ' 対象セル
0005 
0006 Dim borderSettings(0 To 3, 0 To 2) As Variant
0007 
0008 ' 上枠線あり、太さ=xlThick、線種=xlContinuous
0009 borderSettings(0, 0) = True
0010 borderSettings(0, 1) = xlThick
0011 borderSettings(0, 2) = xlContinuous
0012 
0013 ' 下枠線なし
0014 borderSettings(1, 0) = False
0015 borderSettings(1, 1) = ""
0016 borderSettings(1, 2) = ""
0017 
0018 ' 左枠線の指定なし（現状維持）
0019 borderSettings(2, 0) = Empty
0020 borderSettings(2, 1) = ""
0021 borderSettings(2, 2) = ""
0022 
0023 ' 右枠線あり、太さ=xlMedium、線種=xlDash
0024 borderSettings(3, 0) = True
0025 borderSettings(3, 1) = xlMedium
0026 borderSettings(3, 2) = xlDash
0027 ' 背景色を黄色
0028 Dim bgColor As Variant
0029 bgColor = RGB(255, 255, 0)
0030 ' 文字色を赤
0031 Dim fontColor As Variant
0032 fontColor = RGB(255, 0, 0)
0033 ' セルの内容を「テスト」
0034 Dim cellValue As Variant
0035 cellValue = "テスト"
0036 
0037 ' 関数実行
0038 Dim result As Variant
0039 result = SetCellAttributes(cell, borderSettings, bgColor, fontColor, cellValue)
0040 
0041 ' 設定内容を表示
0042 Dim i As Integer
0043 Dim output As String
0044 output = "枠線情報:" & vbCrLf
0045 For i = 1 To 4
0046 output = output & "枠線 " & i & ": " & result(i, 1) & ", 太さ: " & result(i, 2) & ", 線種: " & result(i, 3) & vbCrLf
0047 Next i
0048 output = output & vbCrLf & result(1, 4) & vbCrLf & result(2, 4) & vbCrLf & result(3, 4)
0049 MsgBox output, vbInformation, "セル設定情報"
0050 End Sub