VBA/Excel/Access/Word/Excel/Cell Format
Содержание
- 1 Color cells
- 2 Coloring all negative cells" backgrounds red
- 3 Color multiple-column ranges
- 4 Make a Cell font bold based on the cell value
- 5 Makes cell background red if the value is negative
- 6 Make the font in number cell bold
- 7 Removes all borders for the selected cells
- 8 Set cell color
- 9 Set data to cell D1 of the selected worksheet. And format its contents with color and borders.
- 10 Sets just the color of cell C1 to red.
- 11 the font color of all cells in the active worksheet is set to red
Color cells
Public Sub ColorCells()
Dim Sales As Range
Dim i As Long
Dim j As Long
Set Sales = Range("SalesData")
For i = 1 To Sales.Rows.Count
For j = 1 To Sales.Columns.Count
If Sales.Cells(i, j).Value < 100 Then
Sales.Cells(i, j).Font.ColorIndex = 3
Else
Sales.Cells(i, j).Font.ColorIndex = 1
End If
Next j
Next i
End Sub
Coloring all negative cells" backgrounds red
Sub SelectiveColor1()
If TypeName(Selection) <> "Range" Then Exit Sub
Const REDINDEX = 3
Application.ScreenUpdating = False
For Each Cell In Selection
If Cell.value < 0 Then
Cell.Interior.ColorIndex = REDINDEX
Else
Cell.Interior.ColorIndex = xlNone
End If
Next Cell
End Sub
Color multiple-column ranges
Sub SelectiveColor2()
Dim FormulaCells As range
Dim ConstantCells As range
Const REDINDEX = 3
On Error Resume Next
Application.ScreenUpdating = False
Set FormulaCells = Selection.SpecialCells(xlFormulas, xlNumbers)
Set ConstantCells = Selection.SpecialCells(xlConstants, xlNumbers)
For Each Cell In FormulaCells
If Cell.value < 0 Then _
Cell.Font.ColorIndex = REDINDEX
Next Cell
For Each Cell In ConstantCells
If Cell.value < 0 Then
Cell.Interior.ColorIndex = REDINDEX
Else
Cell.Interior.ColorIndex = xlNone
End If
Next Cell
End Sub
Make a Cell font bold based on the cell value
Sub valueDemo()
If ActiveCell.value = 10 Then
ActiveCell.font.bold = True
End If
End Sub
Makes cell background red if the value is negative
Sub SelectiveColor2()
Dim FormulaCells As Range
Dim ConstantCells As Range
Const REDINDEX = 3
On Error Resume Next
Application.ScreenUpdating = False
Set FormulaCells = Selection.SpecialCells (xlFormulas, xlNumbers)
Set ConstantCells = Selection.SpecialCells (xlConstants, xlNumbers)
For Each cell In FormulaCells
If cell.Value < 0 Then _
cell.Font.ColorIndex = REDINDEX
Next cell
For Each cell In ConstantCells
If cell.Value < 0 Then
cell.Interior.ColorIndex = REDINDEX
Else
cell.Interior.ColorIndex = xlNone
End If
Next cell
End Sub
Make the font in number cell bold
Sub BoldNCRows()
Dim rngRow As Range
For Each rngRow In Cells.SpecialCells(xlCellTypeConstants, xlNumbers).Rows
rngRow.Font.Bold = True
Next rngRow
End Sub
Removes all borders for the selected cells
Sub RemoveAllBorders()
Dim calcModus&, updateModus&, i
Dim rng As Range, ar As Range
Dim brd As Border
If Selection Is Nothing Then Exit Sub
calcModus = Application.Calculation
updateModus = Application.ScreenUpdating
Application.Calculation = xlManual
Application.ScreenUpdating = False
For Each ar In Selection.Areas
For Each rng In ar
For Each i In Array(xlEdgeTop, xlEdgeBottom, xlEdgeLeft, xlEdgeRight, xlDiagonalDown, xlDiagonalUp)
rng.Borders(i).LineStyle = xlLineStyleNone
Next i
If rng.Column > 1 Then
rng.Offset(0, -1).Borders(xlRight).LineStyle = xlLineStyleNone
End If
If rng.Column < 256 Then
rng.Offset(0, 1).Borders(xlLeft).LineStyle = xlLineStyleNone
End If
If rng.Row > 1 Then
rng.Offset(-1, 0).Borders(xlBottom).LineStyle = xlLineStyleNone
End If
If rng.Row < 65536 Then
rng.Offset(1, 0).Borders(xlTop).LineStyle = xlLineStyleNone
End If
Next rng
Next ar
Application.Calculation = calcModus
Application.ScreenUpdating = updateModus
End Sub
Set cell color
Sub Set_Protection()
On Error GoTo errorHandler
Dim myDoc As Worksheet
Dim cel As Range
Set myDoc = ActiveSheet
myDoc.Unprotect
For Each cel In myDoc.UsedRange
cel.Locked = True
cel.Font.ColorIndex = xlColorIndexAutomatic
Next
myDoc.Protect
Exit Sub
errorHandler:
MsgBox Error
End Sub
Set data to cell D1 of the selected worksheet. And format its contents with color and borders.
Sub cmd()
Cells(1, "D").Value = "Text"
Cells(1, "D").Select
With Selection
.Font.Bold = True
.Font.Name = "Arial"
.Font.Size = 72
.Font.Color = RGB(0, 0, 255) "Dark blue
.Columns.AutoFit
.Interior.Color = RGB(0, 255, 255) "Cyan
.Borders.Weight = xlThick
.Borders.Color = RGB(0, 0, 255) "Dark Blue
End With
End Sub
Sets just the color of cell C1 to red.
Sub cellFont()
Cells(1, "C").Font.Color = vbRed
End Sub
the font color of all cells in the active worksheet is set to red
Sub fontColor()
Cells.Font.Color = vbRed
End Sub