搜尋此網誌

2013年1月28日 星期一

Excel VBA改變區塊中的字型顏色(Green, Red, Black)


Sub Program0()

page_num = 2

Sheets(page_num).Range("H1") = Now()

   current_row = 1
   current_Col = 1
   If Sheets(page_num).Cells(current_row, current_Col + 1).Value > 0 Then
        Sheets(page_num).Cells(current_row, current_Col).Font.Color = -16776961 'Color Red
        Sheets(page_num).Cells(current_row, current_Col + 1).Font.Color = -16776961 'Color Red
   Else
        If Sheets(page_num).Cells(current_row, current_Col + 1).Value < 0 Then
            Sheets(page_num).Cells(current_row, current_Col).Font.Color = -11489280 'Color Green
            Sheets(page_num).Cells(current_row, current_Col + 1).Font.Color = -11489280 'Color Green
        Else
            Sheets(page_num).Cells(current_row, current_Col).Font.ColorIndex = xlAutomatic 'Color Black
            Sheets(page_num).Cells(current_row, current_Col + 1).Font.ColorIndex = xlAutomatic 'Color Black
        End If
   End If

For Each x In Sheets(page_num).Range("B4:B30")

   If x.Value > Sheets(page_num).Cells(x.Row, x.Column + 3).Value Then
        x.Font.Color = -16776961
   Else
        If x.Value < Sheets(page_num).Cells(x.Row, x.Column + 3).Value Then
            x.Font.Color = -11489280
        Else
            x.Font.ColorIndex = xlAutomatic
        End If
   End If
   
   change_num = 1
   Sheets(page_num).Cells(x.Row, x.Column + change_num).HorizontalAlignment = xlRight
   Sheets(page_num).Cells(x.Row, x.Column + change_num).Font.ColorIndex = xlAutomatic
   If Sheets(page_num).Cells(x.Row, x.Column + change_num).Value > 0 Then
        Sheets(page_num).Cells(x.Row, x.Column + change_num).Font.Color = -16776961
   Else
        If Sheets(page_num).Cells(x.Row, x.Column + change_num).Value < 0 Then
            Sheets(page_num).Cells(x.Row, x.Column + change_num).Font.Color = -11489280
        End If
   End If
   
   change_num = 2
   Sheets(page_num).Cells(x.Row, x.Column + change_num).HorizontalAlignment = xlRight
   Sheets(page_num).Cells(x.Row, x.Column + change_num).Font.ColorIndex = xlAutomatic
   If Sheets(page_num).Cells(x.Row, x.Column + change_num).Value > 0 Then
        Sheets(page_num).Cells(x.Row, x.Column + change_num).Font.Color = -16776961
   Else
        If Sheets(page_num).Cells(x.Row, x.Column + change_num).Value < 0 Then
            Sheets(page_num).Cells(x.Row, x.Column + change_num).Font.Color = -11489280
        End If
   End If
   
   change_num = 2
   If Sheets(page_num).Cells(x.Row, x.Column + change_num).Value < 0.07 Then
       If Sheets(page_num).Cells(x.Row, x.Column + change_num).Value < -0.07 Then
           For I = 2 To 13
               Sheets(page_num).Cells(x.Row, I).Font.Bold = True 'Enable Boldface
           Next I
       Else
           For I = 2 To 13
               Sheets(page_num).Cells(x.Row, I).Font.Bold = False 'Disable Boldface
           Next I
       End If
   Else
       For I = 2 To 13
           Sheets(page_num).Cells(x.Row, I).Font.Bold = True
       Next I
   End If
   
   x.Font.TintAndShade = 0
   For I = 0 To 4
       change_num = 7 + I
       If Sheets(page_num).Cells(x.Row, x.Column + change_num).Value > Sheets(page_num).Cells(x.Row, x.Column + 3).Value Then
           Sheets(page_num).Cells(x.Row, x.Column + change_num).Font.Color = -16776961
       Else
           If Sheets(page_num).Cells(x.Row, x.Column + change_num).Value < Sheets(page_num).Cells(x.Row, x.Column + 3).Value Then
               Sheets(page_num).Cells(x.Row, x.Column + change_num).Font.Color = -11489280
           Else
               Sheets(page_num).Cells(x.Row, x.Column + change_num).Font.ColorIndex = xlAutomatic
           End If
       End If
   Next I
   
   Next
End Sub

沒有留言:

張貼留言