VBA/Excel/Access/Word/Excel/Cell Format — различия между версиями
Admin (обсуждение | вклад) м (1 версия) |
|
(нет различий)
|
Текущая версия на 15:47, 26 мая 2010
Содержание
- 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
<source lang="vb">
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
</source>
Coloring all negative cells" backgrounds red
<source lang="vb">
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
</source>
Color multiple-column ranges
<source lang="vb">
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
</source>
Make a Cell font bold based on the cell value
<source lang="vb">
Sub valueDemo()
If ActiveCell.value = 10 Then ActiveCell.font.bold = True End If
End Sub
</source>
Makes cell background red if the value is negative
<source lang="vb">
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
</source>
Make the font in number cell bold
<source lang="vb">
Sub BoldNCRows()
Dim rngRow As Range For Each rngRow In Cells.SpecialCells(xlCellTypeConstants, xlNumbers).Rows rngRow.Font.Bold = True Next rngRow
End Sub
</source>
Removes all borders for the selected cells
<source lang="vb">
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
</source>
Set cell color
<source lang="vb">
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
</source>
Set data to cell D1 of the selected worksheet. And format its contents with color and borders.
<source lang="vb">
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
</source>
Sets just the color of cell C1 to red.
<source lang="vb">
Sub cellFont()
Cells(1, "C").Font.Color = vbRed
End Sub
</source>
the font color of all cells in the active worksheet is set to red
<source lang="vb">
Sub fontColor()
Cells.Font.Color = vbRed
End Sub
</source>