Excel/VBAクリニック，今月の診断(14)ケイ線の色を変える
http://itpro.nikkeibp.co.jp/article/COLUMN/20080326/297178/?P=1&ST=develop

 Sub BORDER_COLOR_CHANGE()
   Dim myFile_Name As Variant
   Dim i As Integer
   Dim j As Integer
   Dim myTARGET_BOOK As Workbook
   Dim R As Range
 
   myFile_Name = Application.GetOpenFilename _
       ("Excel ファイル (*.xls), *.xls", MultiSelect:=True)
 
   If IsArray(myFile_Name) = False Then
     Exit Sub
   End If
 
   For i = LBound(myFile_Name) To UBound(myFile_Name)
     Set myTARGET_BOOK = Workbooks.Open(myFile_Name(i))
 
     For j = 1 To myTARGET_BOOK.Worksheets.Count
       For Each R In myTARGET_BOOK.Worksheets(j).UsedRange
         '↓------------(1)
         If Not R.Borders(xlEdgeTop).LineStyle = xlLineStyleNone Then
           R.Borders(xlEdgeTop).ColorIndex = 8
        End If
         '↓------------(2)
         If Not R.Borders(xlEdgeBottom).LineStyle = xlLineStyleNone Then
           R.Borders(xlEdgeBottom).ColorIndex = 8
        End If
         '↓------------(3)
         If Not R.Borders(xlEdgeLeft).LineStyle = xlLineStyleNone Then
           R.Borders(xlEdgeLeft).ColorIndex = 8
        End If
         '↓------------(4)
         If Not R.Borders(xlEdgeRight).LineStyle = xlLineStyleNone Then
           R.Borders(xlEdgeRight).ColorIndex = 8
        End If
         '↓------------(5)
         If Not R.Borders(xlDiagonalDown).LineStyle = xlLineStyleNone Then
           R.Borders(xlDiagonalDown).ColorIndex = 8
        End If
         '↓------------(6)
         If Not R.Borders(xlDiagonalUp).LineStyle = xlLineStyleNone Then
           R.Borders(xlDiagonalUp).ColorIndex = 8
        End If
       Next R
     Next j
 
     myTARGET_BOOK.Close
   Next i
 
   Set myTARGET_BOOK = Nothing
 End Sub

{{category2 OS,Windows}}