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

Question

我正在尝试制作一个 excel ui/macros，它允许用户选择多个 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 工作簿命名

我怎样才能实现这样的目标？这是当前 UI 的截图：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

上面是一个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