我有1000个excel表格,每个excel表都有两个sheet,如何批量操作,打印时只打印sheet1?

发布网友

我来回答

4个回答

热心网友

附件已写好宏,可以实现按文件夹(含所有子文件夹)打印和按文件清单打印的功能:

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积分的可以发消息给我用百度网盘下载,就是要收费喔!

热心网友

编写好

Excel怎样批量打印多个工作簿(文件)的每个表

热心网友

这是别人的,你改一改就能用有备注
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim Wb As Workbook '定义一个wb工作簿变量
On Error Resume Next '容错
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
'多选
.Filters.Clear
'清除文件过滤器
.Filters.Add ".Excel文件", "*.xlsx"
.Filters.Add ".Excel文件", "*.xlsm"
.Filters.Add ".Excel文件", "*.xls"
.Filters.Add "全部文件", "*.*"
'设置两个文件过滤器
If .Show = -1 Then
For i = 1 To .SelectedItems.Count
Set Wb = Workbooks.Open(.SelectedItems(i))
Wb.Sheets(1).PageSetup.PrintArea = Wb.Sheets(1).Range("A1:S35") '设置打印区域
Wb.Sheets(1).PrintOut copies:=1, from:=1, to:=1
Wb.Close
Next
Set Wb = Nothing
End If
End With
Application.ScreenUpdating = True
End Sub

热心网友

下载方方格子插件,批量打印

声明声明:本网页内容为用户发布,旨在传播知识,不代表本网认同其观点,若有侵权等问题请及时与本网联系,我们将在第一时间删除处理。E-MAIL:11247931@qq.com