excel VBA用于用户选择文件并复制选定的工作表,以复制到用户表单中的活动工作簿

aiqt4smr  于 2023-08-08  发布在  其他
关注(0)|答案(1)|浏览(104)

我需要将支持选项卡/工作表复制到正在使用的活动工作簿。我希望用户能够使用VBA文件对话框,能够选择一个文件,在此文件中的选项卡显示在用户窗体中,并让用户选择哪些选项卡复制/移动到活动工作簿。下面是我拥有的最接近的代码,但此代码仅列出活动工作簿中所选工作表的工作表名称。你能帮帮我吗

Dim FilePicker As FileDialog
    Dim mypath As String
    Dim sheet_name As String
    Dim sheet_count As Integer
    Dim i As Integer
    Dim ws As Worksheet
    Dim i As Integer, sht As String, arr() As String, n As Long

    Application.ScreenUpdating = False

    Set ws = ThisWorkbook.Sheets(1)
    Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
    With FilePicker
    .Title = "Please Select a File"
    .ButtonName = "Confirm"
    .AllowMultiSelect = False
    If .Show = -1 Then
    mypath = .SelectedItems(1)
    Else
    End
    End If
    End With

    End Sub

Private Sub CommandButton1_Click()
    Dim i As Integer, sht As String, arr() As String, n As Long
   
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            ReDim Preserve arr(n)
            arr(n) = ListBox1.List(i)
            n = n + 1
        End If
    Next i
    Sheets(arr).Copy
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    With ListBox1
        For sh = 1 To Sheets.Count
            .AddItem ActiveWorkbook.Sheets(sh).Name
        Next sh
        .MultiSelect = 1
    End With
End Sub

字符串
我尝试在用户窗体中使用此代码,但它不能将所选工作簿中的选项卡拉到用户窗体中。我只是得到一个没有任何选项卡显示的空白用户表单。

ahy6op9u

ahy6op9u1#

类似这样的东西应该可以工作:

Option Explicit

Dim wb As Workbook

Private Sub CommandButton1_Click()
    Dim i As Integer, sht As String, arr() As String, n As Long
   
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            ReDim Preserve arr(n)
            arr(n) = ListBox1.List(i)
            n = n + 1
        End If
    Next i
    wb.Sheets(arr).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    wb.Close   '?
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    Dim ws As Worksheet
    Set wb = GetSelectedWorkbook() 'ask user to pick a file
    
    If wb Is Nothing Then 'no file selected
        MsgBox "No file selected!"
        Exit Sub
        Unload Me
    End If
    
    For Each ws In wb.Worksheets
        ListBox1.AddItem ws.Name
    Next ws
    ListBox1.MultiSelect = 1
    
End Sub

Function GetSelectedWorkbook() As Workbook
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Please Select an Excel File"
        .ButtonName = "Confirm"
        .AllowMultiSelect = False
        If .Show = -1 Then Set GetSelectedWorkbook = _
                        Workbooks.Open(.SelectedItems(1))
    End With
End Function

字符串

相关问题