完美Excel

下面的内容及程序代码模仿自《Excel 2007 VBA Programmer’s Reference》，可能在某些情形下极其有用，因此特辑录于此，供参考。
如下图所示，双击工作表Sheet1的列A中的任一单元格，将出现一组合框，允许用户选择其中的项目。当用户选取某项目后，将自动输入到该单元格，并在该单元格右侧的单元格中输入相应的价格数字，组合框同时消失。

下面是程序代码。在工作表Sheet1的代码模块中输入BeforeDoubleClick事件代码：
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     If Not Intersect(Target, Columns(”A”)) Is Nothing Then
         Call AddDropDown(Target)
         Cancel = True
    End If
End Sub
在任一模块中，输入下面的代码：
Sub AddDropDown(Target As Range)
    Dim ddBox As DropDown
    Dim vProducts As Variant
    Dim i As Integer
    ‘创建产品数组
    vProducts = Array(”香蕉”, “苹果”, “菠萝”, “葡萄”)
    ‘在目标单元格中添加下拉控件
    With Target
        Set ddBox = Sheet1.DropDowns.Add(.Left, .Top, .Width, .Height)
    End With
    ‘定义执行的宏并填充列表
    With ddBox
        .OnAction = “EnterProdInfo”
        For i = LBound(vProducts) To UBound(vProducts)
            .AddItem vProducts(i)
        Next i
    End With
End Sub

Private Sub EnterProdInfo()
    Dim vPrices As Variant
    ‘创建价格数组
    vPrices = Array(6, 8, 5, 4)
    ‘输入所选项到相应的单元格
    With Sheet1.DropDowns(Application.Caller)
        .TopLeftCell.Value = .List(.ListIndex)
        .TopLeftCell.Offset(0, 1).Value = vPrices(.ListIndex + LBound(vPrices) - 1)
        ‘删除
        .Delete
    End With
End Sub
如下图所示：

虽然Excel为工作簿和工作表提供了全面的保护，但是这种“生硬的”工具没有限制用户的“特权”，除非您使用一些技巧。
通过监控和响应事件，您能够管理电子表格与用户的交互。事件是处理工作簿和工作表时所发生的操作。一些常见的事件包括打开工作簿、保存工作簿和关闭工作簿。当触发这些事件中的任一事件时，您能告诉Excel自动执行一些VB代码。
提示：用户能够通过完全禁用宏，从而避免所有保护。单击Office按钮─—Excel选项─—信任中心─—信任中心设置，按“宏设置”按钮，如果安全性被设置为“禁用所有宏，并且不通知”，那么在打开含有宏的工作簿时将没有机会运行宏。
阻止工作簿“另存为…”
通过选择Office按钮─—保存─—工具按钮─—常规选项，然后选中“建议只读”复选框，这样可以指定任何工作簿被保存为只读。这能阻止用户对该文件保存所做的任何修改，除非将其保存为不同的名称或者在不同的位置保存该文件。
然而，有时您可能想阻止用户使用或者不使用不同的名称在另一个目录或文件夹中保存工作簿副本。换句话说，您想用户能够在现有文件中保存，而不是在其他地方保存另一个副本。当多个人对某个工作簿保存修改时，这特别方便，此时不会存在保存在不同文件夹中相同工作簿的多个副本。
自从Excel 97后，就可以使用“保存前”事件了。正如其名称所述，该事件在工作簿被保存之前发生，能够在事实发生之前捕获用户、发出警告，以及阻止Excel保存。
要插入代码，打开工作簿并选择“开发工具─—Visual Basic”，双击工程资源管理器中的ThisWorkbook，在VBE中输入下面的代码，如图1所示，然后返回工作簿，再保存工作簿：
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim lReply As Long
    If SaveAsUI = True Then
        lReply = MsgBox(”对不起,不允许您以其它名称保存本工作簿.” & _
            ”您希望保存本工作簿吗?”, vbQuestion + vbOKCancel)
        Cancel = (lReply = vbCancel)
        If Cancel = False Then Me.Save
        Cancel = True
    End If
End Sub

图1：输入到ThisWorkbook中的代码
此时，选择“Office按 钮─—保存”，该工作簿将按预料的那样保存。然而，在选择“Office按钮─—另存为”时，Excel将通知您不能以其它的名称保存该工作簿，除非您禁用宏。
提示：当在Excel 2007中保存工作簿时，如果该工作簿包含宏或代码，那么应该将工作簿保存为启用宏的工作簿（*.xlsm），而不能保存为标准的Excel文件格式（ *.xlsx）。
阻止用户打印工作簿
可能您想阻止用户打印您的工作簿，此时使用Excel的“打印前”事件。在VBE中输入下面的代码：
Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Cancel = True
    MsgBox “对不起,您不能打印本工作簿.”, vbInformation
End Sub
如果希望仅阻止用户打印工作簿中特定的工作表，使用下列代码：
Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Select Case ActiveSheet.Name
        Case “Sheet1″, “Sheet2″
        Cancel = True
        MsgBox “对不起,您不能打印本工作簿中的这个工作表.”, vbInformation
    End Select
End Sub
注意，您指定阻止打印工作表“Sheet1”和“Sheet2”。当然，可以修改为工作簿中的任何工作表的名称。要添加工作表，只需在代码后面加上逗号，然后在双引号中输入该工作表的名称。
阻止用户插入更多的工作表
Excel可以保护工作簿的结构以便用户不能删除工作表、重新排列它们出现的顺序、重新命名它们，等等。但是，有时希望仅阻止添加更多的工作表，而仍然允许其它的结构更改。
可以使用下列代码：
Private Sub Workbook_NewSheet(ByVal Sh As Object)
    Application.DisplayAlerts = False
    MsgBox “对不起,不能对工作簿添加任一工作表.”, vbInformation
    Sh.Delete
    Application.DisplayAlerts = True
End Sub
上述代码首先显示消息框，然后在用户单击消息框中的确定按钮后立即删除新添加的工作表。Application.DisplayAlerts = False语句的阻止标准的Excel警告，即要求用户是否想删除工作表。
另一种阻止用户添加工作表的方法是，选择“审阅─—更改─—保护工作簿”，然后按下“保护结构和窗口”。然而，正如本技巧开始所述，Excel的工作表保护是相当“生硬的”工具，它会同时阻止了许多其它的Excel功能。

注：初译自《Excel Hacks》，仅供参考。

经常需要在多个工作表中重复某些数据。可以使用Excel的组合工具，使得在某工作表中输入数据时能够同时将数据输入到多个工作表中。然而，也有更快速且灵活的方式，即使用VBA代码。
在Excel中，有一项能使数据一次放置在多个位置的功能，称之为组。其操作是通过将工作表组合在一起，以便它们在工作簿内建立链接。
手工组合工作表
要手工使用组的功能，只需简单地单击将要输入数据的工作表，并在单击想要放置数据的工作表的标签名时按住Ctrl键。此时，当在工作表的任意单元格中输入数据时，这些数据也将自动输入到已组合的其它工作表中。
要取消工作表组合，只需单击除组合的工作表之外的其它任一工作表标签，或者在工作表标签中单击右键，选择“取消组合工作表”命令。
提示：当将工作表组合在一起时，能够看到标题栏中在工作簿名称后面添加了一对方括号，其中显示“工作组”。这能很方便地查看工作表是否是组合的。建议在完成同步输入数据操作后，取消工作表组合。
虽然上面介绍的方法很容易，但也意味着需要记住工作表是否处于组合状态，并且在不需要时取消组合，否则将存在覆盖其它工作表数据的风险。例如，您可能想仅对某特定的单元格区域同步输入数据，如果在其它区域输入数据时，忘记取消工作表组合则可能覆盖掉其它工作表中已存在的数据或者输入不需要的数据。
自动组合工作表
能够通过使用一些非常简单的VBA代码克服上述缺点。要使这些代码能够工作，必须将它们放置在Sheet对象的私有模块中。即在VBE中右击工作表名称，选择“查看代码”或者双击工作表名称。然后，使用Excel的工作表事件之一，并将代码放置在事件过程中。
首先命名希望成组的单元格区域，以便在其它工作表中自动显示数据。然后，在工作表模块中输入下面的代码：
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range(”MyRange”), Target) Is Nothing Then
‘有目的的将工作表Sheet5放置在第一位,使之成为活动工作表
Sheets(Array(”Sheet5″, “Sheet3″, “Sheet1″)).Select
Else
Me.Select
End If
End Sub
在代码中，使用了命名的区域MyRange，可以将MyRange修改为您工作表中使用的单元格区域名称，同时修改代码中三个工作表名称为希望组合的工作表名称。

图：自动组合工作表的代码
注意，代码中在数组中使用的第一个工作表名必须是包含代码的工作表，并且您将在该工作表中输入数据。
一旦编写好代码，每次选择工作表中的任意单元格时，代码就会检查是否所选的单元格在命名区域MyRange中。如果在该区域，那么代码将自动组合你希望组合的工作表。如果不在，将通过激活正处理的工作表而取消组合。这项技巧的优点是不需要人工组合工作表，因而没有因为忘记取消组合而造成的危险，同时节省了时间并避免产生障碍。
如果希望在其它工作表中显示相同的数据，但不是出现在相同的单元格地址，那么使用如下的代码：
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range(”MyRange”), Target) Is Nothing Then
With Range(”MyRange”)
.Copy Destination:=Sheets(”Sheet3″).Range(”A1″)
.Copy Destination:=Sheets(”Sheet1″).Range(”D10″)
End With
End If
End Sub
上面的代码也需要放置在Sheet对象的模块中，具体操作与前面内容相同。

注：初译自《Excel Hacks》，仅供参考。

有许多种从关闭的工作簿中取值的方法，下面是其中之一。下面的VBA代码从关闭的工作簿中获取值。
Sub ExtractDataFromClosedWorkBook()
    
    Application.ScreenUpdating = False
    
     ‘创建链接来从关闭的工作簿中获取数据
     ‘可以将相关代码修改为相应的路径和单元格
    With [Sheet1!A1:B4]
        .Value = “=’” & ActiveWorkbook.Path & “\[testDataWorkbook.xls]Sheet1′!A1:B4″
        
         ‘删除链接
        .Value = .Value
    End With
    
    Application.ScreenUpdating = True
    
End Sub

其中，可以将代码中的路径修改为需要从中获取值的工作簿的路径，单元格也作相应的修改。

在dicks的blog中看到了一段解决同名文件问题的程序解决方案，贴出来共享。
有时，必须存储一个名称与现有文件名相同的文件，此时可以在名称末尾添加数字使其唯一。但问题是该文件将放在三个不同的文件夹中：Working、Review和Archive，需要在这三个文件夹中检查相同的文件名称。
现在，创建一个函数来返回下一个可用的后缀，如果没有相同的文件存在，返回空字符串；如果有相同的文件存在，则返回能够添加到文件名后使其唯一的数字。
该函数遍历文件夹并使用Dir函数来获取相同的名称。为了使用Dir，将搜索的文件更改为包含有星号（*），例如名称为MyFile.xls的成为MyFile*.xls，并且将查找MyFile.xls、MyFile1.xls等等。如果找到匹配项，将分隔数字并记录下最终找到的最大的一个数字。如果没有数字，Replace语句返回一个空字符串并且Val函数将其转换为0。
Function GetUniqueSuffix(sName As String, vaFolders As Variant) As String
    Dim lSuffix As Long, lMax As Long
    Dim sDirName As String
    Dim sBaseName As String
    Dim i As Long
    Dim sTempName As String
    
    Const sEXTENSION As String = “.xls”
    
    sDirName = Replace(sName, sEXTENSION, “*” & sEXTENSION)
    sBaseName = Replace(sName, sEXTENSION, “”)
    
    For i = LBound(vaFolders) To UBound(vaFolders)
        sTempName = Dir(vaFolders(i) & sDirName)
        Do Until Len(sTempName) = 0
            lSuffix = Val(Replace(Replace(sTempName, sBaseName, “”), sEXTENSION, “”)) + 1
            If lSuffix > lMax Then
                lMax = lSuffix
            End If
            sTempName = Dir
        Loop
    Next i
    
    If lMax > 0 Then
        GetUniqueSuffix = CStr(lMax)
    Else
        GetUniqueSuffix = “”
    End If
    
End Function

使用示例:
Sub UniqueSuffixExample()
    
    Dim vaFolders As Variant
    Dim sFile As String
    Dim lUnique As Long
    
    vaFolders = Array(”C:\Working\”, “C:\Review\”, “C:\Archive\”)
    sFile = “MyFile.xls”
    
    lUnique = GetUniqueSuffix(sFile, vaFolders)
    sFile = Replace(sFile, “.xls”, lUnique & “.xls”)
    
    ActiveWorkbook.SaveAs “C:\Working\” & sFile
    
End Sub