トップ 差分 一覧 ソース 置換 検索 ヘルプ PDF RSS ログイン

Excelの罫線の色を変える

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

[カテゴリ: OS > Windows]



  • Hatenaブックマークに追加
  • livedoorクリップに追加
  • del.icio.usに追加
  • FC2ブックマークに追加

最終更新時間:2008年05月25日 22時57分17秒