批量打印工作簿

我是小黑屋

求助批量打印某文件夹中所有工作簿中的指定工作表，想实现用窗体来操作，选择指定的文件夹，然后将文件夹中（包含所有子文件夹）所有的xlsm格式的工作簿的文件名和工作簿路径加入到列表框中。点击窗体中批量打印按钮，批量打印这些工作簿中的工作表为"派工单"的工作表。

工作簿1.zip (11.93 KB, 下载次数: 6)

2022-12-21 13:17 上传

点击文件名下载附件

3190496160

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFolderPicker) '
   If .Show Then myPath$ = .SelectedItems(1) Else Exit Sub '
End With '
If Right(myPath, 1) <> "" Then myPath = myPath & "" '
arr = ListAllFsoDic(myPath, 1)
Dim brr()
ReDim brr(1 To 10000, 1 To 3)
n = 1
brr(1, 1) = "序号"
brr(1, 2) = "工作簿名称"
brr(1, 3) = "文件路径"
For i = 0 To UBound(arr)
    m = Dir(arr(i) & "\*.xls*") '
    Do While m <> "" '
        If m <> ThisWorkbook.Name Then '
            n = n + 1
            Set Itm = ListView1.ListItems.Add
            Itm.Text = n - 1 '' ar(i, 1)
            Itm.SubItems(1) = m
            Itm.SubItems(2) = arr(i) & "\" & m
        End If '
    m = Dir '
    Loop '
Next i
Application.ScreenUpdating = True
End Sub


Private Sub CommandButton2_Click()
With ListView1
    For i = 1 To .ListItems.Count Step 1
        wj = .ListItems(i).SubItems(2)
        Set wb = Workbooks.Open(wj)
        wb.Worksheets("派工单").PrintOut
        wb.Close False
    Next i
End With
End Sub

Private Sub UserForm_Initialize()
rr = Array("序号", "工作簿名称", "文件路径")
For j = 0 To UBound(rr)
    ListView1.ColumnHeaders.Add , , rr(j) ', Sheets("物料库存数据").Cells(3, j).Width
Next
ListView1.View = lvwReport
ListView1.FullRowSelect = True
ListView1.Gridlines = True
End Sub

3190496160

工作簿1.rar (26.42 KB, 下载次数: 17)

2022-12-21 15:11 上传

点击文件名下载附件

我是小黑屋

3190496160 发表于 2022-12-21 15:11

非常感谢。完美实现。  对了老师可以改成后台打开工作簿打印，不显示它打开每个工作簿，完成时弹出提示这样

3190496160

我是小黑屋 发表于 2022-12-21 15:39
非常感谢。完美实现。  对了老师可以改成后台打开工作簿打印，不显示它打开每个工作簿，完成时弹出提示这 ...

偏执，没必要

3190496160

Private Sub CommandButton2_Click()
Application.ScreenUpdating = false
With ListView1
    For i = 1 To .ListItems.Count Step 1
        wj = .ListItems(i).SubItems(2)
        Set wb = Workbooks.Open(wj)
        wb.Worksheets("派工单").PrintOut
        wb.Close False
    Next i
End With
Application.ScreenUpdating = True
End Sub