в 16:33, 26 мая 2010

2010-05-26T16:33:00Z

Admin: 1 версия

2010-05-26T12:47:18Z

1 версия

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

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

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

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

в 16:33, 26 мая 2010

Admin: 1 версия