EXCEL VBA-将数据从多个工作簿传输到工作簿模板

Question

我正在尝试制作一个excel ui /宏，允许用户选择多个excel工作簿（wb1，wb2，wb3 ...），并将某些值从它们传输到另一个工作簿（wb_template）。 然后，将其中每个保存为新工作簿（wb1_new，wb2_new，wb3_new ...）。

含义：模板工作簿可以反复使用，并且每次都另存为新工作簿-应该以原始工作簿（wb1）+“ _new”）命名：

>     Wb1 + wb_template = wb1_new
>     Wb2 + wb_template = wb2_new
>     Wb3 + wb_template = wb3_new

总结场景：

• 通过对话框选择多个工作簿
• 在列表框中显示选择
• 将某些值从那些工作簿转移到工作簿模板中
• 从列表框中将工作簿模板另存为每个excel工作簿的新工作簿
• 结果 ：几个新的excel工作簿，以列表框中的原始excel工作簿命名

我怎样才能实现这样的目标？ 这是当前用户界面的屏幕截图： https : //imgur.com/a/ynnhbm0

我有以下代码用于数据传输：

Sub Button1_Click()


Dim wb1 As Workbook
Dim wb_template As Workbook

Set wb1 = Application.Workbooks.Open("C:\Users\PlutoX\Desktop\Folder\wb1")
Set wb_template = Application.Workbooks.Open("C:\Users\PlutoX\Desktop\Folder\wb_template")


wb_template.Sheets("Sheet1").Range("A1").Value = wb1.Sheets("Sheet1").Range("A1").Value
wb_template.Sheets("Sheet1").Range("A2").Value = wb1.Sheets("Sheet1").Range("A2").Value
wb_template.Sheets("Sheet1").Range("A3").Value = wb1.Sheets("Sheet1").Range("A3").Value



wb1.Close False
wb_template.Close True


End Sub

问题：

• 原始文件（wb1）是静态的。 需要一个变量，该变量引用列表框中的选定文件-将选定文件的文件路径添加到代码中

我有以下代码用于对话框窗口/文件选择：

Sub openDialog()
    Dim fd As Office.FileDialog

    Set fd = Application.FileDialog(msoFileDialogFilePicker)

   With fd

      .AllowMultiSelect = True

      ' Set the title of the dialog box.
      .Title = "Please select the file."

      ' Clear out the current filters, and add our own.
      .Filters.Clear
      .Filters.Add "Excel 2003", "*.xls"
      .Filters.Add "All Files", "*.*"

      ' Show the dialog box. If the .Show method returns True, the
      ' user picked at least one file. If the .Show method returns
      ' False, the user clicked Cancel.
      If .Show = True Then
        txtFileName = .SelectedItems(1) 'replace txtFileName with your textbox

      End If
   End With
End Sub

问题：

• 如何在列表框中显示文件名？ 无法解决...
• 如何确保将文件路径从“数据传输”代码移交给变量？

非常感谢您的帮助！

Answer 1

首先，我会说放弃FileDialog并使用Excels内置方法。 就像是：

Private Sub CommandButton1_Click()
    Dim fNames As Variant
    With Me
        fNames = Application.GetOpenFilename("Excel File(s) (*.xls*),*.xls*", , , , True)
        If IsArray(fNames) Then .ListBox1.List = fNames
    End With
End Sub

上面转到您的BrowseFile （来自屏幕截图）按钮。
对于“ Transfer File按钮，您需要迭代到ListBox项。
但是在此之前，您需要使文件传输为Sub通用。 就像是：

Sub Transferfile(wbTempPath As String, wbTargetPath As String)

    Dim wb1 As Workbook
    Dim wb_template As Workbook

    Set wb1 = Workbooks.Open(wbTargetPath)
    Set wb_template = Workbooks.Open(wbTempPath)

    '/* I believe this should be dynamic but that is another story */
    wb_template.Sheets("Sheet1").Range("A1").Value = wb1.Sheets("Sheet1").Range("A1").Value
    wb_template.Sheets("Sheet1").Range("A2").Value = wb1.Sheets("Sheet1").Range("A2").Value
    wb_template.Sheets("Sheet1").Range("A3").Value = wb1.Sheets("Sheet1").Range("A3").Value

    wb1.Close False
    wb_template.Close True

End Sub

上面是一个带有2个参数的Sub过程。
现在，剩下的部分是“ Transfer File按钮的代码，看起来应该像这样：

Private Sub CommandButton2_Click()    
    Dim i As Integer
    '/* I assumed it is fixed, note that you need the full path */
    Const mytemplate As String = "C:\Users\PlutoX\Desktop\Folder\wb_template.xlsx"
    With Me
        With .ListBox1
            '/* iterate listbox items */
            For i = 0 To .ListCount - 1
                '/* transfer the files using your generic procedure */
                Transferfile mytemplate, .List(i, 0)
            Next
        End With
    End With    
End Sub