в 16:33, 26 мая 2010

2010-05-26T16:33:00Z

Admin: 1 версия

2010-05-26T12:47:47Z

1 версия

Новая страница

==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>

← Предыдущая	Версия 16:33, 26 мая 2010
(нет различий)

VBA/Excel/Access/Word/Excel/Cell Format - История изменений

в 16:33, 26 мая 2010

Admin: 1 версия