如何通过创建浏览按钮打开和读取 *.xls 文件

Question

我已经在 Google 上搜索了将近一天，但实际上找不到我要找的东西！

我在我的 Excel 工作表上创建了一个按钮。我希望这个按钮从浏览器对话框中打开一个 .xls 文件。我设法在下面找到了程序代码，但它在新工作簿中打开了我的 .xls。

我希望 .xls 文件在与按钮相同的工作表中的特定单元格中打开。例如，我将按钮放置在 sheet1 的单元格 B8 中。我想在它下面打开 .xls 文件 - 在同一张 sheet1 的单元格 B9 中

还有一件事，当我按下按钮并按下“取消”时，我不希望它打印“FALSE”。

这是我找到的代码：

Sub Knapp1_Klicka()

    objFile = Application.GetOpenFilename(fileFilter:="All Files (* . *) , * . * ")   

    Set curSheet = ActiveSheet
    Set mWorkbook = Workbooks.Open(objFile)
    curSheet.Activate

    Call someFunction(curSheet, mWorkbook)
End Sub

Sub someFunction(targetSheet, srcWorkbook)

    numSheets = srcWorkbook.Sheets.Count
    For i = 1 To numSheets
        targetSheet.Cells(i, 1) = srcWorkbook.Sheets(i).Name
    Next i
End Sub

Answer 1

要处理取消事件，您需要检查Application.GetOpenFileName 的结果是一个有效的文件名。您可以使用Dir 函数来做到这一点。

始终声明变量也很有帮助。

Sub TryMe()
    Dim objFile as String
    Dim curSheet as Worksheet
    Dim mWorkbook as Workbook
    objFile = Application.GetOpenFilename(fileFilter:="All Files (* . *) , * . * ")   

    If Len(Dir(objFile)) = 0 Then Exit Sub 'handles the "Cancel" event
    Set curSheet = ActiveSheet
    Set mWorkbook = Workbooks.Open(objFile)

    'Copy the values from the activesheet in this workbook:
    ActiveSheet.UsedRange.Copy Destination:=curSheet.Range("B9")
End Sub

请注意，如果您在工作簿中使用非常大的范围，此方法可能会失败，因为它无法复制整个工作表并粘贴到范围 B9，但发生这种情况的可能性似乎很低（基本上它会如果mWorkbook 工作表的所有列和行中的数据完全充满，就会发生这种情况。