'罫線色を設定するマクロ

'MakeDialogSheetマクロを実行してダイアログシートを作成します。
'（必要であれば修正してください。）

'セル範囲を選択して、MyBorderColorマクロを実行してください。

Option Explicit

Const DialogSheetName = "色パレット"
Const DialogFontSize = 9

Sub MyBorderColor()
    Const myTitle = "罫線色の設定"
    Dim i As Integer
    Dim r As Range, r2 As Range, obj As Object

    On Error GoTo err_1

    If TypeName(Selection) <> "Range" Then
        MsgBox "セル範囲を選択して実行してください。", _
            vbExclamation, myTitle
        Exit Sub
    End If

    With ThisWorkbook.DialogSheets(DialogSheetName)
        If .Show Then
            i = .Buttons(1).Caption
            If i = 0 Then
                If MsgBox("選択範囲の罫線を削除します。", _
                    vbExclamation Or vbOKCancel, myTitle) = vbOK Then
                    Selection.Borders.LineStyle = xlNone
                End If
                Exit Sub
            End If

            Application.ScreenUpdating = False
            For Each r In Selection.Areas
                For Each r2 In r.Cells
                    For Each obj In r2.Borders
                        If obj.LineStyle <> xlNone Then obj.ColorIndex = i
                    Next
                Next
            Next
        End If
    End With
    Exit Sub
err_1:
    MsgBox Error(Err) & " (" & Err & ")", vbExclamation, myTitle
End Sub

Sub RectanglesClick()
    With ActiveDialog
        .Focus = .Buttons(1).Name
        .Buttons(1).Caption = Right$(Application.Caller, 2)
        .Hide
    End With
End Sub

Sub MakeDialogSheet()
    Dim dlg As DialogSheet
    Dim gw As Double, left1 As Double, top1 As Double
    Dim i As Integer

    For Each dlg In ThisWorkbook.DialogSheets
        If dlg.Name = DialogSheetName Then
            MsgBox DialogSheetName & " シートはすでに存在します。", _
                vbExclamation, "MakeDialogSheet"
            Exit Sub
        End If
    Next

    Application.ScreenUpdating = False
    Set dlg = ThisWorkbook.DialogSheets.Add
    dlg.Name = DialogSheetName
    gw = dlg.Buttons(1).Height / 3
    dlg.DrawingObjects.Delete
    With dlg.DialogFrame
        .Width = gw * 18: .Height = gw * 21
        .Caption = "色パレット"
    End With
    With dlg.Buttons.Add(dlg.DialogFrame.Left + gw * 24, _
            dlg.DialogFrame.Top, gw, gw)
        .Caption = ""
        .Width = gw * 10: .Height = gw * 3
    End With
    With dlg.TextBoxes.Add(dlg.DialogFrame.Left + gw, _
            dlg.DialogFrame.Top + gw * 3, gw, gw)
        .Name = "txt00"
        .OnAction = "RectanglesClick"
        .Border.ColorIndex = 15
        .Interior.ColorIndex = 2
        .Text = "なし"
        .Font.Size = DialogFontSize
        .Width = gw * 16: .Height = gw * 3
    End With
    left1 = dlg.DialogFrame.Left + gw
    top1 = dlg.DialogFrame.Top + gw * 6
    For i = 0 To 55
        With dlg.Rectangles.Add(left1 + (i Mod 8) * gw * 2, _
                top1 + (i \ 8) * gw * 2, gw, gw)
            .Name = "rct" & Format$(i + 1, "00")
            .OnAction = "RectanglesClick"
            .Border.ColorIndex = 15
            .Interior.ColorIndex = i + 1
            .Height = gw * 2: .Width = gw * 2
        End With
    Next
End Sub