VBA/Excel/Access/Word/Excel/Range Format
Содержание
- 1 Add & format totals
- 2 Change range border color
- 3 Change range border style
- 4 Changes color of numbers
- 5 Changes font to bold
- 6 Format current region
- 7 Format date on report
- 8 Formatting Range: Font
- 9 Formatting Range: HorizontalAlignment, VerticalAlignment, MergeCells
- 10 Line style: xlContinuous
- 11 Line style: xlDash
- 12 Line style: xlDashDot
- 13 Line style: xlDashDotDot
- 14 Line style: xlDot
- 15 Line style: xlDouble
- 16 Line style: xlLineStyleNone
- 17 Line style: xlSlantDashDot
- 18 Make column headings bold
- 19 Make text in first column bold
- 20 Providing Dynamic Scaling to Your Worksheets
- 21 Sets to True the Bold property of the Font object contained in the Range object
- 22 Set the color for whole range
- 23 Set the underline, color and font name
- 24 Specify colors with VBA"s RGB function.
- 25 Strolling Through the Color Palette
- 26 The Font property
- 27 The Interior property:changes the Color property of the Interior object contained in the Range object:
- 28 Use the Range and Cells properties of the Worksheet object to return a Range object.
- 29 Using the Interior Object to Alter the Background of a Range
- 30 Widen first column to display text
Add & format totals
<source lang="vb">
Sub RigidFormattingProcedure()
ActiveSheet.Range("N7:N15").Formula = "=SUM(RC[-12]:RC[-1])" ActiveSheet.Range("N7:N15").Font.Bold = True ActiveSheet.Range("B16:N16").Formula = "=SUM(R[-9]C:R[-1]C)" ActiveSheet.Range("B16:N16").Font.Bold = True
End Sub
" Format data range
Sub RigidFormattingProcedure()
ActiveSheet.Range("B7:N16").NumberFormat = "#,##0"
End Sub
</source>
Change range border color
<source lang="vb">
Sub BorderDemo()
With Range("A1:E5") .BorderAround ColorIndex:=1 End With
End Sub
</source>
Change range border style
<source lang="vb">
Sub Extend()
With Range("A1:E5") .Borders.LineStyle = xlLineStyleNone .Resize(.Rows.Count + 1).Name = "Database" End With
End Sub
</source>
Changes color of numbers
<source lang="vb">
Sub ColorCells1()
Dim myRange As Range Dim i As Long, j As Long Set myRange = Range("A1:A5") For i = 1 To myRange.Rows.Count For j = 1 To myRange.Columns.Count If myRange.Cells(i, j).Value < 100 Then myRange.Cells(i, j).Font.ColorIndex = 3 Else myRange.Cells(i, j).Font.ColorIndex = 1 End If Next j Next i
End Sub
</source>
Changes font to bold
<source lang="vb">
Sub Bold()
Dim rngRow As Range For Each rngRow In Range("A1:E5").Rows If rngRow.Cells(1).Value > 1 Then rngRow.Font.Bold = True Else rngRow.Font.Bold = False End If Next rngRow
End Sub
</source>
Format current region
<source lang="vb">
Sub FormatCurrentRegion()
Set WorkRange = ActiveCell.CurrentRegion WorkRange.Font.Bold = True
End Sub
</source>
Format date on report
<source lang="vb">
Sub RigidFormattingProcedure()
ActiveSheet.Range("A2").NumberFormat = "mmm-yy"
End Sub
</source>
Formatting Range: Font
<source lang="vb"> Sub InsertHeader() Range("A1:C1").Select With Selection.Font .Name = "Arial" .FontStyle = "Bold" .Size = 14 End With End Sub </source>
Formatting Range: HorizontalAlignment, VerticalAlignment, MergeCells
<source lang="vb"> Sub InsertHeader() Range("A1:C1").Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .MergeCells = True End With End Sub </source>
Line style: xlContinuous
<source lang="vb">
Sub BorderLineSytlesII()
Dim rg As Range Set rg = ThisWorkbook.Worksheets("Borders").Range("A1:E3") rg.Offset(1, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous Set rg = Nothing
End Sub
</source>
Line style: xlDash
<source lang="vb">
Sub BorderLineSytlesII()
Dim rg As Range Set rg = ThisWorkbook.Worksheets("Borders").Range("A1:E3") rg.Offset(1, 2).Borders(xlEdgeBottom).LineStyle = xlDash Set rg = Nothing
End Sub
</source>
Line style: xlDashDot
<source lang="vb">
Sub BorderLineSytlesII()
Dim rg As Range Set rg = ThisWorkbook.Worksheets("Borders").Range("A1:E3") rg.Offset(1, 2).Borders(xlEdgeBottom).LineStyle = xlDashDot Set rg = Nothing
End Sub
</source>
Line style: xlDashDotDot
<source lang="vb">
Sub BorderLineSytlesII()
Dim rg As Range Set rg = ThisWorkbook.Worksheets("Borders").Range("A1:E3") rg.Offset(1, 2).Borders(xlEdgeBottom).LineStyle = xlDashDotDot Set rg = Nothing
End Sub
</source>
Line style: xlDot
<source lang="vb">
Sub BorderLineSytlesII()
Dim rg As Range Set rg = ThisWorkbook.Worksheets("Borders").Range("A1:E3") rg.Offset(1, 2).Borders(xlEdgeBottom).LineStyle = xlDot Set rg = Nothing
End Sub
</source>
Line style: xlDouble
<source lang="vb">
Sub BorderLineSytlesII()
Dim rg As Range Set rg = ThisWorkbook.Worksheets("Borders").Range("A1:E3") rg.Offset(1, 2).Borders(xlEdgeBottom).LineStyle = xlDouble Set rg = Nothing
End Sub
</source>
Line style: xlLineStyleNone
<source lang="vb">
Sub BorderLineSytlesII()
Dim rg As Range Set rg = ThisWorkbook.Worksheets("Borders").Range("A1:E3") rg.Offset(1, 2).Borders(xlEdgeBottom).LineStyle = xlLineStyleNone Set rg = Nothing
End Sub
</source>
Line style: xlSlantDashDot
<source lang="vb">
Sub BorderLineSytlesII()
Dim rg As Range Set rg = ThisWorkbook.Worksheets("Borders").Range("A1:E3") rg.Offset(1, 2).Borders(xlEdgeBottom).LineStyle = xlSlantDashDot Set rg = Nothing
End Sub
</source>
Make column headings bold
<source lang="vb">
Sub RigidFormattingProcedure()
ActiveSheet.Range("6:6").Font.Bold = True
End Sub
</source>
Make text in first column bold
<source lang="vb">
Sub RigidFormattingProcedure()
ActiveSheet.Range("A:A").Font.Bold = True
End Sub
</source>
Providing Dynamic Scaling to Your Worksheets
<source lang="vb">
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Me.Range("ScaleFactor").Address Then ScaleData End If
End Sub Private Sub ScaleData()
If Me.Range("ScaleFactor").Value = "Normal" Then Me.Range("ScaleRange").NumberFormat = "#,##0" Else Me.Range("ScaleRange").NumberFormat = "#," End If
End Sub
</source>
Sets to True the Bold property of the Font object contained in the Range object
<source lang="vb">
Sub bold()
range("A1").font.bold = True
End Sub
</source>
Set the color for whole range
<source lang="vb">
Sub ColorCells4()
Dim Rng As Range For Each Rng In Range("A1:E5") If Rng.Value < 100 Then Rng.Font.ColorIndex = 4 Else Rng.Font.ColorIndex = 1 End If Next Rng
End Sub
</source>
Set the underline, color and font name
<source lang="vb">
Sub DemonstrateFontObject()
Dim nColumn As Integer Dim nRow As Integer Dim avFonts As Variant Dim avColors As Variant avFonts = Array("Tahoma", "Arial", "MS Sans Serif", "Verdana", "Georgia") avColors = Array(vbRed, vbBlue, vbBlack, vbGreen, vbYellow) For nRow = 1 To 5 With ThisWorkbook.Worksheets(1).Rows(nRow).Font .Color = avColors(nRow - 1) .Name = avFonts(nRow - 1) If nRow Mod 2 = 0 Then .Underline = True Else .Underline = False End If End With Next
End Sub
</source>
Specify colors with VBA"s RGB function.
<source lang="vb">
Sub rgbDemo()
range("A1").Interior.color = rgb(0, 0, 0) "black range("A2").Interior.color = rgb(255, 0, 0) " pure red range("A3").Interior.color = rgb(0, 0, 255) " pure blue range("A4").Interior.color = rgb(128, 128, 128) " middle gray
End Sub
</source>
Strolling Through the Color Palette
<source lang="vb">
Sub ViewWorkbookColors()
Dim rg As Range Dim nIndex As Integer Set rg = ThisWorkbook.Worksheets("Sheet1").Range("A1:E5").Offset(1, 0) For nIndex = 1 To 56 rg.Value = nIndex rg.Offset(0, 1).Interior.ColorIndex = nIndex rg.Offset(0, 2).Value = rg.Offset(0, 1).Interior.Color Set rg = rg.Offset(1, 0) Next Set rg = Nothing
End Sub
</source>
The Font property
<source lang="vb">
Sub font()
Debug.Print range("A1").font.Background
End Sub
</source>
The Interior property:changes the Color property of the Interior object contained in the Range object:
<source lang="vb">
Sub color()
range("A1").Interior.color = 8421504
End Sub
</source>
Use the Range and Cells properties of the Worksheet object to return a Range object.
<source lang="vb">
Sub rangeColor()
Range("A:B").Font.Color = vbRed
End Sub
</source>
Using the Interior Object to Alter the Background of a Range
<source lang="vb">
Sub InteriorExample()
Dim rg As Range Set rg = ThisWorkbook.Worksheets("Sheet1").Range("A1").Offset(1, 0) Do Until IsEmpty(rg) rg.Offset(0, 2).Interior.Pattern = rg.Offset(0, 1).Value rg.Offset(0, 3).Interior.Pattern = rg.Offset(0, 1).Value rg.Offset(0, 3).Interior.PatternColor = vbRed Set rg = rg.Offset(1, 0) Loop " create examples of each VB defined color constant Set rg = ThisWorkbook.Worksheets("Sheet1").Range("A1:E3").Offset(1, 0) Do Until IsEmpty(rg) rg.Offset(0, 2).Interior.Color = rg.Offset(0, 1).Value Set rg = rg.Offset(1, 0) Loop Set rg = Nothing
End Sub
</source>
Widen first column to display text
<source lang="vb">
Sub RigidFormattingProcedure()
ActiveSheet.Range("A:A").EntireColumn.AutoFit
End Sub
</source>