[已解决]批量删除没进行过打印设置的工作表

zhaohu800 · 发表于 2016-11-21 10:04

一个工作簿中有很多张工作表，有些工作表有打印设置，有些没有，有打印设置的工作表要保留，其他的全部删除，就是根据是否进行过打印设置来判断要不要删除，请问各位大师这个用VBA怎么实现？

最佳答案

爱疯

2016-11-22 08:53

Sub test4()
Dim sh As Worksheet
Application.DisplayAlerts = False
For Each sh In Sheets
If sh.PageSetup.PrintArea <> "" Then sh.Delete
Next
End Sub

跳转到最佳答案楼层

爱疯 · 发表于 2016-11-21 10:55

Sub test()
Dim sh As Worksheet
Application.DisplayAlerts = False
For Each sh In Sheets
      Debug.Print sh.Name, isDefault(sh)
'       If isDefault(sh) = False Then sh.Delete
Next
End Sub

Function isDefault(sh) As Boolean
Dim x As Boolean
x = True
With sh.PageSetup
      x = x And .AlignMarginsHeaderFooter = True
      x = x And .BlackAndWhite = False
      x = x And .BottomMargin = Application.InchesToPoints(0.75)
      x = x And .CenterFooter = ""
      x = x And .CenterHeader = ""
      x = x And .CenterHorizontally = False
      x = x And .CenterVertically = False
      x = x And .DifferentFirstPageHeaderFooter = False
      x = x And .Draft = False
      x = x And .EvenPage.CenterFooter.Text = ""
      x = x And .EvenPage.CenterHeader.Text = ""
      x = x And .EvenPage.LeftFooter.Text = ""
      x = x And .EvenPage.LeftHeader.Text = ""
      x = x And .EvenPage.RightFooter.Text = ""
      x = x And .EvenPage.RightHeader.Text = ""
      x = x And .FirstPage.CenterFooter.Text = ""
      x = x And .FirstPage.CenterHeader.Text = ""
      x = x And .FirstPage.LeftFooter.Text = ""
      x = x And .FirstPage.LeftHeader.Text = ""
      x = x And .FirstPage.RightFooter.Text = ""
      x = x And .FirstPage.RightHeader.Text = ""
      x = x And .FirstPageNumber = xlAutomatic
      x = x And .FooterMargin = Application.InchesToPoints(0.3)
      x = x And .HeaderMargin = Application.InchesToPoints(0.3)
      x = x And .LeftFooter = ""
      x = x And .LeftHeader = ""
      x = x And .LeftMargin = Application.InchesToPoints(0.7)
      x = x And .OddAndEvenPagesHeaderFooter = False
      x = x And .Order = xlDownThenOver
      x = x And .Orientation = xlPortrait
      x = x And .PaperSize = xlPaperA4
      x = x And .PrintArea = ""
      x = x And .PrintComments = xlPrintNoComments
      x = x And .PrintErrors = xlPrintErrorsDisplayed
      x = x And .PrintGridlines = False
      x = x And .PrintHeadings = False
      x = x And Join(ActiveSheet.PageSetup.PrintQuality) = "600 600"
      x = x And .PrintTitleColumns = ""
      x = x And .PrintTitleRows = ""
      x = x And .RightFooter = ""
      x = x And .RightHeader = ""
      x = x And .RightMargin = Application.InchesToPoints(0.7)
      x = x And .ScaleWithDocHeaderFooter = True
      x = x And .TopMargin = Application.InchesToPoints(0.75)
      x = x And .Zoom = 100
End With
isDefault = x
End Function

先看看判断。
如果是，再启用蓝色那句。

zhaohu800 · 发表于 2016-11-21 11:25

所有的工作表判断出来都是False

爱疯 · 发表于 2016-11-21 11:31

把附件发上来看看

zhaohu800 · 发表于 2016-11-21 11:45

本帖最后由 zhaohu800 于 2016-11-21 12:35 编辑

附件已上传，表格太多，只留了几个，请帮忙看一下

爱疯 · 发表于 2016-11-22 08:34

3.rar (21.1 KB, 下载次数: 2)

2016-11-22 08:23 上传

点击文件名下载附件

Sub test2()
Dim sh As Worksheet
Dim j As Integer
Application.DisplayAlerts = False
j = 2

For Each sh In Sheets
      j = j + 1
      Cells(1, j) = sh.Name
      With sh.PageSetup
         Cells(2, j) = .AlignMarginsHeaderFooter
         Cells(3, j) = .BlackAndWhite
         Cells(4, j) = .BottomMargin
         Cells(5, j) = .CenterFooter
         Cells(6, j) = .CenterHeader
         Cells(7, j) = .CenterHorizontally
         Cells(8, j) = .CenterVertically
         Cells(9, j) = .DifferentFirstPageHeaderFooter
         Cells(10, j) = .Draft
         Cells(11, j) = .EvenPage.CenterFooter.Text
         Cells(12, j) = .EvenPage.CenterHeader.Text
         Cells(13, j) = .EvenPage.LeftFooter.Text
         Cells(14, j) = .EvenPage.LeftHeader.Text
         Cells(15, j) = .EvenPage.RightFooter.Text
         Cells(16, j) = .EvenPage.RightHeader.Text
         Cells(17, j) = .FirstPage.CenterFooter.Text
         Cells(18, j) = .FirstPage.CenterHeader.Text
         Cells(19, j) = .FirstPage.LeftFooter.Text
         Cells(20, j) = .FirstPage.LeftHeader.Text
         Cells(21, j) = .FirstPage.RightFooter.Text
         Cells(22, j) = .FirstPage.RightHeader.Text
         Cells(23, j) = .FirstPageNumber
         Cells(24, j) = .FooterMargin
         Cells(25, j) = .HeaderMargin
         Cells(26, j) = .LeftFooter
         Cells(27, j) = .LeftHeader
         Cells(28, j) = .LeftMargin
         Cells(29, j) = .OddAndEvenPagesHeaderFooter
         Cells(30, j) = .Order
         Cells(31, j) = .Orientation
         Cells(32, j) = .PaperSize
         Cells(33, j) = .PrintArea
         Cells(34, j) = .PrintComments
         Cells(35, j) = .PrintErrors
         Cells(36, j) = .PrintGridlines
         Cells(37, j) = .PrintHeadings
         Cells(38, j) = Join(ActiveSheet.PageSetup.PrintQuality)
         Cells(39, j) = .PrintTitleColumns
         Cells(40, j) = .PrintTitleRows
         Cells(41, j) = .RightFooter
         Cells(42, j) = .RightHeader
         Cells(43, j) = .RightMargin
         Cells(44, j) = .ScaleWithDocHeaderFooter
         Cells(45, j) = .TopMargin
         Cells(46, j) = .Zoom
      End With
Next
End Sub

绿色，是通过修改某一项页面设置，得到页面设置的所有缺省值。
黄色，是各个表页面设置的所有当前参数值
共有45项参数。

1楼说"有些工作表有打印设置"，我理解是：只要在这45项参数中，有1项参数值和缺省值不一样，就表示有打印设置。
那么，这些（前4个）的工作表都得删。
除非，1楼题意是其它含义。

zhaohu800 · 发表于 2016-11-22 08:43

前面三个是需要打印的，不能能删除，就是最后一个含量表这个不需要打印，把这个工作表删除就可以

爱疯 · 发表于 2016-11-22 08:45

有些工作表有打印设置，请说明一下这句的具体含义。
即，怎样算有打印设置，怎样不算有打印设置

zhaohu800 · 发表于 2016-11-22 08:50

就是设置过打印区域，前面三个表都有设置过打印区域，最后一个没有设置过打印区域，就这个工作表要删除

爱疯 · 发表于 2016-11-22 08:53

Sub test4()
Dim sh As Worksheet
Application.DisplayAlerts = False
For Each sh In Sheets
If sh.PageSetup.PrintArea <> "" Then sh.Delete
Next
End Sub

		自动登录	找回密码
密码			注册

[已解决]批量删除没进行过打印设置的工作表

相关帖子