10 探索其他Excel对象

10.1 产生一个好的第一印象

10.1.1 为我们的世界着色

rgb(red:=[0,225],green:=[0,225],blue:=[0,225])

此函数生成一个表示颜色的整数。VBA预定义了一些少量的颜色值，如vbBlack, vbRed等。

代码清单10.1：颜色的乐趣

Sub ColorWorksheet()
    Dim ws As Worksheet
    Dim lRow As Long
    Dim lColumn As Long
    Dim lColor As Long

    Set ws = ThisWorkbook.Worksheets()
    lRow =
    lColumn = 

    Application.ScreenUpdating = False
    Application.StatusBar = "On column " & lColumn

    '256 * 256 * 256 - 1
    For lColor =  To  *  *  -
        'record color
        ws.Cells(lRow, lColumn).Interior.Color = lColor

        'move to next cell
        lRow = lRow + 

        'worksheet has 65,536 rows
        If lRow =  Then
            lRow =
            lColumn = lColumn +
            Application.StatusBar = "On column " & lColumn
        End If
    Next

    Set ws = Nothing
    Application.ScreenUpdating = True
    Application.StatusBar = False
End Sub

能够显示一个颜色的对象都有一个ColorIndex属性。属性ColorIndex的值相当于颜色面板的一个索引。颜色面板是每个工作薄专有的。

10.1.2 字体的细微之处

Font对象表示字体。常用属性有Bold, Color, Italic, Name, Size, Underline等。关于Font对象的详细信息，参见：http://msdn.microsoft.com/en-us/library/ff840959(v=office.15).aspx

代码清单10.2：Font对象—一个简单、直观的对象

Sub DemonstrateFontObject()
    Dim nColumn As Long
    Dim nRow As Long
    Dim avFonts As Variant

    Dim avColors As Variant

    For nColumn =  To
        With ThisWorkbook.Worksheets().Columns(nColumn).Font
            .Size = nColumn +
            If nColumn Mod  =  Then
                .Bold = True
                .Italic = False
            Else
                .Bold = False
                .Italic = True
            End If
        End With
    Next

    avFonts = Array("Tahoma", "Arial", "MS Sans Serif", "Verdana", "Georgia")
    avColors = Array(vbRed, vbBlue, vbBlack, vbGreen, vbYellow)
    For nRow =  To
        With ThisWorkbook.Worksheets().Rows(nRow).Font
            .Color = avColors(nRow - )
            .Name = avFonts(nRow - )

            If nRow Mod  =  Then
                .Underline = True
            Else
                .Underline = False
            End If
        End With
    Next
End Sub

10.1.3 内部布置

Interior对象代表一个范围或者其他对象的背景。参见：http://msdn.microsoft.com/en-us/library/ff196598(v=office.15).aspx

代码清单10.3：使用Interior对象改变一个范围的背景

Sub InteriorExample()
    Dim rg As Range

    'create examples of each pattern
    Set rg = ThisWorkbook.Worksheets("Interior").Range("ListStart").Offset(, )

    Do Until IsEmpty(rg)
        rg.Offset(, ).Interior.Pattern = rg.Offset(, ).Value
        rg.Offset(, ).Interior.Pattern = rg.Offset(, ).Value
        rg.Offset(, ).Interior.PatternColor = vbRed
        Set rg = rg.Offset(, )
    Loop

    'create example of each vb defined color constant
    Set rg = ThisWorkbook.Worksheets("Interior").Range("ColorListStart").Offset(, )
    Do Until IsEmpty(rg)
        rg.Offset(, ).Interior.Color = rg.Offset(, ).Value
        Set rg = rg.Offset(, )
    Loop
    Set rg = Nothing

End Sub

以上例子应该从帮助文件中复制常数名称和对应值粘贴到名称（第一列）与值（第二列）列。

代码清单10.4：漫步通过颜色面板

Sub ViewWorkbookColors()
    Dim rg As Range
    Dim nIndex As Long

    Set rg = ThisWorkbook.Worksheets("Interior").Range("ColorIndexListStart").Offset(, )

    For nIndex =  To
        rg.Value = nIndex
        rg.Offset(, ).Interior.ColorIndex = nIndex
        rg.Offset(, ).Value = rg.Offset(, ).Interior.Color

        Set rg = rg.Offset(, )
    Next
    Set rg = Nothing
End Sub

工作薄的颜色面板保存了56个颜色，颜色索引的范围是1到56。

10.1.4 这些边界不需要签证

Range对象有一个Borders属性和BordersAround方法。它们被用来操作Range的边框。Borders属性返回Border对象的集合。

Range.Borders属性，参见：http://msdn.microsoft.com/en-us/library/ff822605(v=office.15).aspx

Borders对象，参见：http://msdn.microsoft.com/en-us/library/ff837809(v=office.15).aspx

Border对象，参见：http://msdn.microsoft.com/en-us/library/ff838428(v=office.15).aspx

代码清单10.5：与Border对象相关联的各种属性

Sub BorderLineStyles()
    Dim rg As Range
    Set rg = ThisWorkbook.Worksheets("Borders").Range("LineStyleListStart").Offset(, )

    Do Until IsEmpty(rg)
        rg.Offset(, ).Borders(xlEdgeBottom).LineStyle = rg.Offset(, ).Value
        Set rg = rg.Offset(, )
    Loop

    Set rg = Nothing
End Sub

代码清单10.6：代码清单10.5的一个替代方法

Sub BorderLineStyles2()
    Dim rg As Range
    Set rg = ThisWorkbook.Worksheets("Borders").Range("LineStyleListStart")

    rg.Offset(, ).Borders(xlEdgeBottom).LineStyle = xlContinuous
    rg.Offset(, ).Borders(xlEdgeBottom).LineStyle = xlDash
    rg.Offset(, ).Borders(xlEdgeBottom).LineStyle = xlDashDot
    rg.Offset(, ).Borders(xlEdgeBottom).LineStyle = xlDashDotDot
    rg.Offset(, ).Borders(xlEdgeBottom).LineStyle = xlDot
    rg.Offset(, ).Borders(xlEdgeBottom).LineStyle = xlDouble
    rg.Offset(, ).Borders(xlEdgeBottom).LineStyle = xlLineStyleNone
    rg.Offset(, ).Borders(xlEdgeBottom).LineStyle = xlSlantDashDot

    Set rg = Nothing
End Sub

expression.BorderAround(LineStyle, Weight, ColorIndex, Color, ThemeColor)

用于围绕范围创建一个边界。参见：http://msdn.microsoft.com/en-us/library/ff197210(v=office.15).aspx

10.1.5 格式化数字

NumberFormat属性是一个描述范围值如何输出的字符串。

在Excel帮助中搜索：创建或删除自定义数字格式，可以查看关于格式字符串的详细解释。

代码清单10.7：试验格式代码

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = Me.Range("FormatCode").Address Then
        ApplyFormatCode
    End If
End Sub
Private Sub ApplyFormatCode()
    'if we attempt to apply an invalid
    'number format code an error will
    'occur - we need to catch it
    On Error GoTo ErrHandler
    'clear any prior invalid code message
    Me.Range("FormatCode").Offset(, ).Value = ""
    'attempt to apply the format code
    Me.Range("TestFormatCode").NumberFormat = Me.Range("formatcode").Value
    Exit Sub

ErrHandler:
    'OOPS-invalid format code
    'set the format to general
    Me.Range("TestFormatCode").NumberFormat = "General"
    'let the user know what happened
    Me.Range("FormatCode").Offset(, ).Value = "Invalid Format Code!"

End Sub

10.1.6 缩放工作表时节省大量时间

下面演示通过修改NumberFormat来缩放数值的显示。

代码清单10.8：为报表提供动态缩放

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

10.2 图表操作

10.2.1 从头创建图表

代码清单10.9：使用ChartWizard方法创建一个新图表

'creates a chart using the ChartWizard Method
Sub CreateExampleChartVersionI()
    Dim ws As Worksheet
    Dim rgChartData As Range
    Dim chrt As Chart

    Set ws = ThisWorkbook.Worksheets("Basic Chart")
    Set rgChartData = ws.Range("B1").CurrentRegion

    'create a new empty chart
    Set chrt = Charts.Add

    'embed chart in worksheet - this creates a new object
    Set chrt = chrt.Location(xlLocationAsObject, ws.Name)

    'use chart wizard to populate/format empty chart
    chrt.ChartWizard _
         Source:=rgChartData, _
         Gallery:=xlColumn, _
         Format:=, _
         PlotBy:=xlColumns, _
         categorylabels:=, _
         serieslabels:=, _
         HasLegend:=True, _
         Title:="Gross Domestric Product Version I", _
         Categorytitle:="year", _
         valuetitle:="GDP in billions of $"

    Set chrt = Nothing
    Set rgChartData = Nothing
    Set ws = Nothing
End Sub

代码清单10.10：使用Chart对象创建一个图表

'creates a chart using basic chart properties and Methods
Sub CreateExampleChartVersionII()
    Dim ws As Worksheet
    Dim rgChartData As Range
    Dim chrt As Chart

    Set ws = ThisWorkbook.Worksheets("Basic Chart")
    Set rgChartData = ws.Range("B1").CurrentRegion

    'create a new empty chart
    Set chrt = Charts.Add

    'embed chart in worksheet - this creates a new object
    Set chrt = chrt.Location(xlLocationAsObject, ws.Name)

    With chrt
        .SetSourceData rgChartData, xlColumns
        .HasTitle = True
        .ChartTitle.Caption = "Gross Domestric Product Version II"
        .ChartType = xlConeColClustered

        With .Axes(xlCategory)
            .HasTitle = True
            .AxisTitle.Caption = "Year"
        End With

        With .Axes(xlValue)
            .HasTitle = True
            .AxisTitle.Caption = "GDP in billions of $"
        End With
    End With

    Set chrt = Nothing
    Set rgChartData = Nothing
    Set ws = Nothing
End Sub

10.2.2 图表搜索

可以像工作表一样引用图表页

    Dim chrt1 As Chart
    Dim chrt2 As Chart 

    'set a reference to the chart sheet named Chart4
    Set chrt1 = ThisWorkbook.Charts("Chart4") 

    'set a reference to the 2nd chart sheet in this workbook
    Set chrt2 = ThisWorkbook.Charts()

如果图表嵌入在一个工作表中，我们需要使用ChartObjects集合。

    Dim ws As Worksheet 

    Dim chrt1 As Chart
    Dim chrt2 As Chart 

    Set ws = ThisWorkbook.Worksheets() 

    'set a reference to the embedded chart named Chart4
    Set chrt1 = ws.ChartObjects("Chart4").Chart 

    'set a reference to the 2nd embedded chart
    Set chrt2 = ws.ChartObjects().Chart

代码清单10.11：使用图表标题查寻图表

'searches charts on a worksheet by chart title
Function GetChartByCaption(ws As Worksheet, sCaption As String) As Chart
    Dim cht As Chart
    Dim chtObj As ChartObject
    Dim sTitle As String

    Set cht = Nothing

    'loop through all chart objects on the ws
    For Each chtObj In ws.ChartObjects
        'make sure current chart object chart has a title
        If chtObj.Chart.HasTitle Then
            sTitle = chtObj.Chart.ChartTitle.Caption
            'is this title a match?
            If StrComp(sTitle, sCaption, vbTextCompare) =  Then
                ' bingo
                Set cht = chtObj.Chart
                Exit For
            End If
        End If
    Next    

    Set GetChartByCaption = cht

    Set chtObj = Nothing
    Set cht = Nothing
End Function

Sub TestGetChartByCaption()
    Dim ws As Worksheet
    Dim cht As Chart

    Set ws = ThisWorkbook.Worksheets("Basic Chart")
    Set cht = GetChartByCaption(ws, "I am the Chart Title")

    If Not cht Is Nothing Then
        MsgBox "Found chart"
    Else
        MsgBox "Sorry, Can not Found chart"
    End If

    Set cht = Nothing
    Set ws = Nothing
End Sub

代码清单10.12：格式化一个基本图表

Sub FormattingCharts()
    Dim ws As Worksheet
    Dim cht As Chart
    Dim ax As Axis

    Set ws = ThisWorkbook.Worksheets("Basic Chart")
    Set cht = GetChartByCaption(ws, "GDP")

    If Not cht Is Nothing Then
        'Format category axis
        Set ax = cht.Axes(xlCategory)
        With ax
            .AxisTitle.Font.Size =
            .AxisTitle.Font.Color = vbRed
        End With

        'Format value axis
        Set ax = cht.Axes(xlValue)
        With ax
            .HasMinorGridlines = True
            .MinorGridlines.Border.LineStyle = xlDashDot
        End With

        'format plot area
        With cht.PlotArea
            .Border.LineStyle = xlDash
            .Border.Color = vbRed
            .Interior.Color = vbWhite
            .Width = cht.PlotArea.Width +
            .Height = cht.PlotArea.Height +
        End With

        'format misc other
        cht.ChartArea.Interior.Color = vbWhite
        cht.Legend.Position = xlLegendPositionBottom
    End If

    Set ax = Nothing
    Set cht = Nothing
    Set ws = Nothing
End Sub