时间戳

首页 > 解决方案 > Excel VBA 使用对话框将工作簿复制到另一个工作簿

vba - Excel VBA 使用对话框将工作簿复制到另一个工作簿

问题描述

我是 Excel VBA 编程的初学者，我的任务是在 Excel 中开发一个用于监控的工具。我确实有其他语言的知识，如 Java、C++ 和 Python，因此我知道如何做逻辑，但 VBA 是一个困难的语言。

事情：我需要开始工作如下：我有一个工作簿，我们称之为 Tool.xlsm，我在其中编写了排序和过滤逻辑。这部分工作正常。它在该工作簿中使用单独的工作表作为“背景数据”。这张单子就是关于这个的。

我想编写一个显示文件选择对话框的宏。然后将所选文件复制到我的工作簿中的新工作表中。该文件是一个带有 3 张纸的 .xls 表。所需数据在表 1 中。

Public Sub copyData()
Set appxl = CreateObject("Excel.application")
Dim myfile As Window
Dim currentSheet As Worksheet
Dim lastRow As Double
Dim sourceFileName As String

sourceFileName = "FileToCopy.xlsx"

'Open Source File.xlsx
With appxl
.Workbooks.Open ActiveWorkbook.Path & "\" & sourceFileName
.Visible = False
End With    

'Get first sheet data
Set myfile = appxl.Windows(sourceFileName)
myfile.Activate
Set currentSheet = appxl.Sheets(1)

'Past the table in my current Excel file
lastRow = currentSheet.Range("A1").End(xlDown).Row
Sheets("Data retrieval").Range("A1:Y" & lastRow) = currentSheet.Range("A1:Y"& lastRow).Value

'Close Source File.xlsx
appxl.Workbooks(sourceFileName).Close
End Sub

这是我在著名的 GoogleSearch 的帮助下编写的代码。

现在到具体问题：

  1. 如何编写 FileSelectionDialouge？
  2. 如何修复错误 9，outofBounds？

我在 Stackoverflow 中搜索了很长时间，但没有发现类似的问题。这是我在这里的第一篇文章，对于所犯的任何错误，我深表歉意。我也为任何语法或词汇错误道歉，英语不是我的母语:)

非常感谢您的阅读。

忍萨

编辑：我已根据以下答案修改了代码。现在看起来像这样：

Public Sub copyData2()
Set appxl = CreateObject("Excel.application")
Dim myfile As Window
Dim currentSheet As Worksheet
Dim lastRow As Double
Dim sourceFileName As String

'Ask the user to select a file
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .ButtonName = "Import File"
    .InitialView = msoFileDialogViewSmallIcons
    .Title = "Please Select File"
    If .Show = -1 Then Collation_File = .SelectedItems(1)
End With


sourceFileName = Collation_File

'Open Source File.xlsx
With appxl
    .Workbooks.Open Collation_File
    .Visible = False
End With

'Get first sheet data
Set myfile = appxl.Windows(sourceFileName)
myfile.Activate
Set currentSheet = Workbooks("sourceFileName").Sheets(1)

'Past the table in my current Excel file
lastRow = currentSheet.Range("A1").End(xlDown).Row
Debug.Print lastRow
Sheets("test").Range("A1:Y" & lastRow) = currentSheet.Range("A1:Y" & lastRow).Value

'Close Source File.xlsx
appxl.Workbooks(sourceFileName).Close
End Sub

标签： vbaexcel

解决方案

对于第一部分，您可以根据MSDN中的这篇文章使用以下功能

Function GetFileName() As String

    GetFileName = ""
    ' Open the file dialog
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        If .Show = -1 Then
            GetFileName = .SelectedItems(1)
        End If
    End With

End Function

更新我将您的代码重写为

Public Sub copyData()
    Dim sourceWkb As Workbook
    Dim sourceWks As Worksheet
    Dim targetWks As Worksheet
    Dim sourceFilename As String
    Dim lastRow As Long

    Set targetWks = Sheets("Data retrieval")

    sourceFilename = GetFileName
    Set sourceWkb = Workbooks.Open(sourceFilename)
    Set sourceWks = sourceWkb.Sheets(1)


    'Past the table in my current Excel file
    lastRow = sourceWks.Range("A1").End(xlDown).Row
    targetWks.Range("A1:Y" & lastRow) = sourceWks.Range("A1:Y" & lastRow).Value

    'Close Source File.xlsx
    sourceWkb.Close False
End Sub

使用Application.ScreenUpdating = False您可以关闭屏幕闪烁。

推荐阅读