2009年6月18日木曜日

罫線や色を付ける

今回は、罫線や色を付ける機能を追加します。

下記サンプルを見ればわかりますが、罫線サブルーチンと色づけサブルーチンを追加して、前回作成した計算サブルーチンで、その2つのサブルーチンを呼ぶようにしただけです。

Option Explicit

Public Sub 計算()
  Dim i As Integer, wJCL数合計 As Integer, wPGM数合計 As Integer
  i = 1
  'ループ(繰り返し)の開始
  Do
     i = i + 1
     '該当行の1列目が空白(空値)の場合
     If Cells(i, 1) = "" Or Cells(i, 1) = "合計" Then
        'ループを抜ける
        Exit Do
     End If
     wJCL数合計 = wJCL数合計 + Cells(i, 2)
     wPGM数合計 = wPGM数合計 + Cells(i, 3)
  'ループの終了
  Loop
  '最終行+1行目の1列目に「合計」という文字をセット
  Cells(i, 1) = "合計"
  '最終行+1行目の2列目にJCL数合計をセット
  Cells(i, 2) = wJCL数合計
  '最終行+1行目の3列目にPGM数合計をセット
  Cells(i, 3) = wPGM数合計
  Call 罫線
  Call 色づけ
End Sub

Public Sub 罫線()
   Dim i As Integer
    'A1セル~C8セルを選択
    'Range("A1:C8").Select
    i = 1
    Do
       i = i + 1
       If Cells(i, 1) = "" Then
          Exit Do
       End If
    Loop
    Range(Cells(1, 1), Cells(i - 1, 3)).Select
    '選択しているセルに対して、罫線なしにする
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    '選択しているセルに対して、左罫線をセットする
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous     'ラインスタイル
        .Weight = xlThin              '太さ
        .ColorIndex = xlAutomatic     '色
    End With
    '選択しているセルに対して、上罫線をセットする
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    '選択しているセルに対して、下罫線をセットする
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    '選択しているセルに対して、右罫線をセットする
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    '選択しているセルに対して、水平罫線をセットする
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    '選択しているセルに対して、垂直罫線をセットする
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    '1行目1列目を選択
    Cells(1, 1).Select    '→Range("A1").Selectと書いても良いが、処理系では、Cellsを使用した方が便利
End Sub

Public Sub 色づけ()
    '全セルを選択
    Cells.Select
    '選択しているセルの背景色をなしにする
    Selection.Interior.ColorIndex = xlNone
    'A9セル~C9セルを選択
    Range("A9:C9").Select
    '選択しているセルの装飾をセット
    With Selection.Interior
        .ColorIndex = 4        '背景色を緑色にセット
        .Pattern = xlSolid     '塗り潰し(網掛けなし)
    End With
    'Range("A9:C9").Interior.ColorIndex = 4
    'Cells(9,1).Interior.ColorIndex = 4
    'Cells(9,2).Interior.ColorIndex = 4
    'Cells(9,3).Interior.ColorIndex = 4
    'A1セルを選択
    Range("A1").Select
End Sub

'色づけと同じ動きとなる
Public Sub 色づけ1()
    '全セルを選択
    Cells.Select
    '選択しているセルの背景色をなしにする
    Selection.Interior.ColorIndex = xlNone
    'A9セル~C9セルを選択
    Range("A9:C9").Interior.ColorIndex = 4
    'A1セルを選択
    Range("A1").Select
End Sub

'色づけと同じ動きとなる
Public Sub 色づけ2()
    '全セルを選択
    Cells.Select
    '選択しているセルの背景色をなしにする
    Selection.Interior.ColorIndex = xlNone
    'A9セル~C9セルを選択
    Cells(9, 1).Interior.ColorIndex = 4
    Cells(9, 2).Interior.ColorIndex = 4
    Cells(9, 3).Interior.ColorIndex = 4
    'A1セルを選択
    Range("A1").Select
End Sub


実行ボタンを押すと、下図のようになったと思います。



大分、プログラムらしくなりましたね!


それでは!

0 件のコメント:

コメントを投稿