第18章 基本用户界面

18.1 Excel中的用户界面
18.2 原始控件

18.2.1 无处不在的按钮

18.2.2 自由选择

 

代码清单18.1: 控制工作表的可视度 

'代码清单18.1: 控制工作表的可视度
Sub SetWorksheetVisibility()
    Dim ws As Worksheet
    On Error Resume Next
    
    Set ws = ThisWorkbook.Worksheets("Checks and Options")
    Application.ScreenUpdating = False
    
    ThisWorkbook.Worksheets("Sheet1").Visible = CInt(ws.Range("ViewSheet1").Value)
    ThisWorkbook.Worksheets("Sheet2").Visible = CInt(ws.Range("ViewSheet2").Value)
    ThisWorkbook.Worksheets("Sheet3").Visible = CInt(ws.Range("ViewSheet3").Value)
    
    Application.ScreenUpdating = True    
    Set ws = Nothing
End Sub

 

 

代码清单18.2: 确定缩放范围的程序 

'代码清单18.2: 确定缩放范围的程序
Sub ScaleOption()
    Dim ws As Worksheet    
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets("Checks and Options")
    ws.Range("ReportRange").NumberFormat = ws.Range("ReportScale").Value
    
    Set ws = Nothing
End Sub

 

 

18.2.3制作一个列表

代码清单18.3: 协调列表信息 

'代码清单18.3: 协调列表信息
Sub GetVerdict()
    Dim ws As Worksheet
    Dim nChildNumber As Integer
    Dim sVerdict As String
    
    On Error Resume Next

    Set ws = ThisWorkbook.Worksheets("Lists")    
    nChildNumber = ws.Range("ChildNumber")
    
    'Get the current verdict associated with the child
    sVerdict = ws.Range("ChildList").Offset(nChildNumber, 1)
    
    If sVerdict = "Naughty" Then
        'Activate the Naughty option
        ws.Range("Verdict").Value = 1
    Else
        'Activate the nice option
        ws.Range("Verdict").Value = 2
    End If
    Set ws = Nothing
End Sub

Sub SetVerdict()
    Dim ws As Worksheet
    Dim nChildNumber As Integer
    
    On Error Resume Next
    
    Set ws = ThisWorkbook.Worksheets("Lists")
    nChildNumber = ws.Range("ChildNumber")
    
    If ws.Range("Verdict").Value = 1 Then
        'Update the child's verdict to Naughty
        ws.Range("ChildList").Offset(nChildNumber, 1).Value = "Naughty"
    Else
        'Update the child's verdict to Nice
        ws.Range("ChildList").Offset(nChildNumber, 1).Value = "Nice"
    End If
    
    Set ws = Nothing
End Sub

 

18.2.4 滚动和微调

代码清单18.4: 调整列宽 

'代码清单18.4: 调整列宽
Sub AdjustColumns()
    Dim ws As Worksheet
    On Error Resume Next
    
    Set ws = ThisWorkbook.Worksheets("Spinners")
    ws.Columns.ColumnWidth = ws.Range("ColumnWidth").Value
    
    Set ws = Nothing
End Sub

 

18.3 好像儿童进了糖果商店
18.4 通过封面判断内容

代码清单18.5: 创建一个超链接菜单 

'代码清单18.5: 创建一个超链接菜单

'Create a hyperlink to each worksheet in the
'workbook excluding the worksheet containing rgLinks.
Sub CreateLinks(rgLinks As Range)
    Dim ws As Worksheet
    
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> rgLinks.Parent.Name Then
            rgLinks.Hyperlinks.Add rgLinks, ThisWorkbook.Name, "," & ws.Name & "'!A1", ws.Name, ws.Name
            Set rgLinks = rgLinks.Offset(1, 0)
        End If
    Next
    Set ws = Nothing
End Sub

'Example of how to use the CreateLinks procedure
'to create hyperlinks on the Menu worksheet.
'Assumes a range name "TOC" is present that
'represents where the links should go.
Sub CreateMenuLinks()
    CreateLinks ThisWorkbook.Worksheets("Menu").Range("TOC").Offset(1, 0)
End Sub