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(1)
    lRow = 1
    lColumn = 1
    
    Application.ScreenUpdating = False
    Application.StatusBar = "On column " & lColumn
    
    '256 * 256 * 256 - 1
    For lColor = 0 To 256 * 256 * 256 - 1
        'record color
        ws.Cells(lRow, lColumn).Interior.Color = lColor
        
        'move to next cell
        lRow = lRow + 1
        
        'worksheet has 65,536 rows
        If lRow = 65537 Then
            lRow = 1
            lColumn = lColumn + 1
            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 = 1 To 5
        With ThisWorkbook.Worksheets(1).Columns(nColumn).Font
            .Size = nColumn + 10
            If nColumn Mod 2 = 0 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 = 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

 

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(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 example of each vb defined color constant
    Set rg = ThisWorkbook.Worksheets("Interior").Range("ColorListStart").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

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

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

Sub ViewWorkbookColors()
    Dim rg As Range
    Dim nIndex As Long
    
    Set rg = ThisWorkbook.Worksheets("Interior").Range("ColorIndexListStart").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

工作薄的颜色面板保存了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(1, 0)
    
    Do Until IsEmpty(rg)
        rg.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = rg.Offset(0, 1).Value
        Set rg = rg.Offset(1, 0)
    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(1, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
    rg.Offset(2, 2).Borders(xlEdgeBottom).LineStyle = xlDash
    rg.Offset(3, 2).Borders(xlEdgeBottom).LineStyle = xlDashDot
    rg.Offset(4, 2).Borders(xlEdgeBottom).LineStyle = xlDashDotDot
    rg.Offset(5, 2).Borders(xlEdgeBottom).LineStyle = xlDot
    rg.Offset(6, 2).Borders(xlEdgeBottom).LineStyle = xlDouble
    rg.Offset(7, 2).Borders(xlEdgeBottom).LineStyle = xlLineStyleNone
    rg.Offset(8, 2).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(0, 1).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(0, 1).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:=1, _
         PlotBy:=xlColumns, _
         categorylabels:=1, _
         serieslabels:=1, _
         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(2)

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

    Dim ws As Worksheet 
    
    Dim chrt1 As Chart 
    Dim chrt2 As Chart 
    
    Set ws = ThisWorkbook.Worksheets(1) 
    
    '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(2).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) = 0 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 = 12
            .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 + 10
            .Height = cht.PlotArea.Height + 10            
        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