发布网友 发布时间:2022-04-26 15:20
共4个回答
热心网友 时间:2023-10-11 12:33
附件已写好宏,可以实现按文件夹(含所有子文件夹)打印和按文件清单打印的功能:
1. 操作界面如图:
2. 代码如下,可以自行制作宏文件:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim iPath As String, i As Long
Dim t
Dim PathLen As Integer
Dim RunSignal As Variant, Reply As Variant
Dim Tr As Single, Tc As Single
Tr = Target.Row
Tc = Target.Column
If Tr = 1 Then
If Tc = 1 Then
RunSignal = "List"
Reply = MsgBox("This operation will print out files listed in column A! Please make sure your print setting is excellent enough!", vbOKCancel, "Warning")
If Reply = vbCancel Then
Exit Sub
End If
ElseIf Tc = 3 Then
RunSignal = "Folder"
Reply = MsgBox("This operation will list all files in specified folder first. And then, print out! Please make sure you choosed the right folder!", vbOKCancel, "Warning")
If Reply = vbCancel Then
Exit Sub
End If
Else
Exit Sub
End If
Else
Exit Sub
End If
t = Timer
Application.ScreenUpdating = False
If RunSignal = "List" Then
GoTo Line1
ElseIf RunSignal = "Folder" Then
ActiveSheet.UsedRange.Offset(1, 2).ClearContents
End If
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select a folder please!"
If .Show Then
iPath = .SelectedItems(1)
PathLen = Len(iPath)
Else
Exit Sub
End If
End With
If iPath = "False" Or Len(iPath) = 0 Then Exit Sub
i = 1
Call GetFolderFile(iPath, i)
Line1: Call PrintFiles(RunSignal)
MsgBox "Completed in " & Int((Timer - t) / 3600) & " hours " & Int(((Timer - t) Mod 3600) / 60) & " minutes " & (Timer - t) Mod 60 & " seconds!", vbOKOnly, "Time record"
Application.ScreenUpdating = True
End Sub
Private Sub GetFolderFile(ByVal nPath As String, ByRef iCount As Long)
Dim iFileSys
Dim J As Single
Dim Process As Variant, P As Integer
Dim ProcessLen As Integer
Set iFileSys = CreateObject("Scripting.FileSystemObject")
Set ifolder = iFileSys.GetFolder(nPath)
Set sfolder = ifolder.SubFolders
Set ifile = ifolder.Files
With ActiveSheet
For Each gfile In ifile
If gfile.Type Like "*Excel*" And Not gfile.Path Like "*~$*" Then
.Cells(iCount + 1, 3) = gfile.Path
.Cells(iCount + 1, 4) = gfile.DateLastModified
.Cells(iCount + 1, 5) = gfile.parentfolder
.Hyperlinks.Add anchor:=.Cells(iCount + 1, 6), Address:=gfile.Path, TextToDisplay:=gfile.Name
iCount = iCount + 1
End If
Next
End With
For Each nfolder In sfolder 'Search all the folders
Call GetFolderFile(nfolder.Path, iCount)
Next
End Sub
Sub PrintFiles(ByVal RunSignal As Variant)
Dim Wb As Workbook
Dim Sho As Worksheet
Dim Fs As Single, FCount As Single, C As Single
Application.DisplayAlerts = False
Set Sho = ActiveSheet
If RunSignal = "List" Then
C = 1
ElseIf RunSignal = "Folder" Then
C = 3
End If
FCount = Sho.Cells(10000, C).End(xlUp).Row
If FCount <= 2 Then
MsgBox ("Nothing can be printed!")
Exit Sub
Else
For Fs = 2 To FCount
Set Wb = Workbooks.Open(Sho.Cells(Fs, C).Text)
Wb.Sheets(1).PrintOut
Wb.Close savechanges = False
Next
End If
Application.DisplayAlerts = True
End Sub
3. 想要现成文档可以在这个链接下载启用宏的文档
4. 没有CSDN积分的可以发消息给我用百度网盘下载,就是要收费喔!
热心网友 时间:2023-10-11 12:34
编写好
Excel怎样批量打印多个工作簿(文件)的每个表
热心网友 时间:2023-10-11 12:34
这是别人的,你改一改就能用有备注热心网友 时间:2023-10-11 12:35
下载方方格子插件,批量打印