Office中国论坛/Access中国论坛

标题: 删除隐藏行列及删除打印区域外的内容 [打印本页]

作者: hahazeng 时间: 2015-1-7 15:35
标题: 删除隐藏行列及删除打印区域外的内容
大家好，如何下面程序中增加“删除隐藏行列及删除打印区域外的内容”功能，隐藏行列数量位置不定，具体可见附件。
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Mc As String, n%
Dim Sh As Worksheet
Dim ShName As String
With ThisWorkbook
For n = 24 To .Sheets("输入表").[J65536].End(xlUp).Row
Mc = .Sheets("输入表").Cells(n, 10).Value
.Sheets("输入表").[K14] = Mc
.Sheets("信息").[D11] = Mc
   .Sheets("输入表").[L19] = "无线"
   .Sheets("信息").[G9] = "无线"
   .Sheets(Array("表一")).Copy
   ActiveWorkbook.SaveAs Filename:=.Path & "\" & Mc & "(无线)概算.xls", FileFormat:=xlNormal
   ActiveSheet.UsedRange = ActiveSheet.UsedRange.Value
   ActiveSheet.DrawingObjects.Delete

   For Each Sh In ActiveWorkbook.Sheets
      Sh.Select
      Sh.Cells.Select
      Selection.Copy
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      Sh.Cells(1, 1).Select
   Next

   ActiveWorkbook.Close (True)

   .Sheets("输入表").[L19] = "电源"
   .Sheets("信息").[G9] = "电源"
   .Sheets(Array("表一")).Copy
   ActiveWorkbook.SaveAs Filename:=.Path & "\" & Mc & "(电源)概算.xls", FileFormat:=xlNormal
   ActiveSheet.UsedRange = ActiveSheet.UsedRange.Value
   ActiveSheet.DrawingObjects.Delete

   For Each Sh In ActiveWorkbook.Sheets
      Sh.Select
      Sh.Cells.Select
      Selection.Copy
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      Sh.Cells(1, 1).Select
   Next

   ActiveWorkbook.Close (True)

   .Sheets("输入表").[L19] = "配套"
   .Sheets("信息").[G9] = "配套"
   .Sheets(Array("表一")).Copy
   ActiveWorkbook.SaveAs Filename:=.Path & "\" & Mc & "(配套)概算.xls", FileFormat:=xlNormal
   ActiveSheet.UsedRange = ActiveSheet.UsedRange.Value
   ActiveSheet.DrawingObjects.Delete


   For Each Sh In ActiveWorkbook.Sheets
      Sh.Select
      Sh.Cells.Select
      Selection.Copy
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      Sh.Cells(1, 1).Select
   Next

   ActiveWorkbook.Close (True)

Next
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

作者: hahazeng 时间: 2015-1-7 19:36
往前顶一下

作者: hahazeng 时间: 2015-1-8 15:11
高手去哪儿啦

作者: hahazeng 时间: 2015-1-13 15:55
再次顶，往前顶

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)