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