VBA - 使用对话框提示用户从下拉列表中选择一个工作表？

Question

现在，我的代码使用一个对话框提示用户选择一个文件，然后使用另一个对话框从该文件中选择一个工作表。选择工作表后，它会复制该工作表中的一堆数据。代码有效，一切都很好。

问题是，它提示用户选择工作表的方式是手动输入。如果它显示一个包含所有工作表名称的下拉列表供用户选择，那就太好了。我不确定这是否可能。为简单起见，我想要发生的是：

1. 系统会提示用户并选择一个文件
2. 出现下拉列表，其中包含所选文件中的所有工作表名称。
3. 选择工作表后，整个工作表将被复制并粘贴到执行宏的工作簿中。

我的工作代码：

Sub ImportData()
Dim w As String, wb As Workbook, FileSelected As String, wsDest as Worksheet, wsSrc as Worksheet

Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogOpen)
     .Title = "Choose File"
     .AllowMultiSelect = False
     If .Show <> - 1 Then Exit Sub
     FileSelected = .SelectedItems(1)
End With
Set wsDest = ActiveSheet
set wb = Workbooks.Open(FileSelected)

w = InputBox("Enter Sheet Name")
On Error Resume Next
Set wsSrc = w.Worksheets(w)
On Error GoTo 0

If wsSrc is Nothing Then
     MsgBox "Sheet '" & w & "' was not find in " & wb.Name
Else
     wsSrc.Range("A1").CurrentRegion.Copy wsDest.Range("A4")    'unnecessary if I just copy the whole sheet over
End If

wb.Close
Application.ScreenUpdating = True
End Sub

Answer 1

这个答案是“便宜”的“从多个中选择一个”解决方案。仅当您有有限数量的选项（在您的情况下为工作表）可供选择时（任何超过 20 或 30 的选项都会使对话框太大），它才会起作用。如果您的工作表数量比这个多，那么@Andre（带有组合框的用户表单）指出的解决方案是正确的方法（事实上，这是我自己更喜欢的解决方案......但更复杂...... .但我很高兴更新此答案，并提供一些有关如何实施该解决方案（如果您确实需要）的指导）。

因此，首先，在您的 VBA 项目的标准模块中添加以下函数...如果您愿意，您可以将其与您的

ImportData

Sub 放在同一模块中。该函数有标题注释，解释了它的作用及其限制...请在使用它之前阅读这些注释！它还在其中进行了注释以解释它在做什么。另请注意，该功能不仅限于选择工作表...如果您的项目要求用户从多个选项中进行单个选择，那么您可以重复使用该功能。

' ---------------------------------------------------------------------------------------------------------------------
' Purpose: Allow the user to make a single selection from multiple options ... note that:
'     * The maximum length of text that can be shown to the user is 1023 characters including the initial text and the
'       list of options ... text will be truncated (and, so, options not displayed) if longer than this
'     * The number of options that can be shown is limited only by the size of the dialog and the height of the screen,
'       so realistically need to limit to around 30 items ... but better with much less!
' Parameter vOptions (Variant): The options to select from ... a 1D array of primitive (Strings, numerics etc) types
' Parameter sText (String): What is being selected from eg "Select an option"
' Parameter sTitle (String): Optionally, title text for the dialog ... if omitted, will be the name of the host app
' Returns (Long): The index number selected by the user (this will always be the index within the supplied array, not
'     necessarily the index displayed to the user in the dialog) or -1 if the user did not select a valid option (eg
'     pressed 'Cancel', did not enter a number, entered an invalid number, entered text etc) and so you should not use
'     arrays with negative indexes with this Function
' ---------------------------------------------------------------------------------------------------------------------
Function InputBoxSingleSelect(vOptions As Variant, sText As String, Optional sTitle As String = "") As Long
    ' get some values relating to the supplied array
    Dim lMax As Long, lOffset As Long
    lMax = UBound(vOptions) - LBound(vOptions) + 1
    lOffset = 1 - LBound(vOptions)
    
    ' construct the text to show to the user, including the list of options
    Dim i As Long, sMsg As String
    For i = LBound(vOptions) To UBound(vOptions)
        sMsg = sMsg & vbNewLine & CStr(i + lOffset) & ": " & vOptions(i)
    Next i
    sMsg = sText & ", enter a number from 1 to " & lMax & vbNewLine & sMsg
    
    ' show the dialog to the user and get the response
    Dim sReply As String, lReply As Long
    sReply = VBA.InputBox(sMsg, IIf(Len(sTitle) = 0, Application.Name, sTitle))
    
    ' get the response as an index of the supplied array, or fail gracefully
    On Error GoTo invalidReply
    InputBoxSingleSelect = -1
    lReply = CLng(sReply)
    If lReply >= 1 And lReply <= lMax Then
        InputBoxSingleSelect = lReply - lOffset
    End If
invalidReply:
End Function

接下来，将问题代码中从

w = InputBox("Enter Sheet Name")

到

On Error GoTo 0

（含）的 4 行替换为以下行：

Dim sNames As String, wks1 As Worksheet
For Each wks1 In wb.Worksheets
    sNames = sNames & wks1.Name & "["  ' [ cannot be used in Worksheet names so is safe to use as a delimiter here
Next wks1
Dim lIndex As Long
lIndex = InputBoxSingleSelect(Split(Left$(sNames, Len(sNames) - 1), "["), "Select a Worksheet")
If lIndex <> -1 Then
    Set wsSrc = wb.Worksheets(lIndex + 1)
End If

...这些行构建了每个工作表名称的字符串，由“[”字符分隔（不能在工作表名称中使用），使用

Left$

和

Len

函数删除了最终的“[”，我们然后将

Split

放入数组中以传递给

InputBoxSingleSelect

函数。如果用户做出了有效的选择（“无效”选择会导致返回值 -1），我们会从

InputBoxSingleSelect

获取返回值，并获取对相应工作表的引用。