设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 2930|回复: 3
打印 上一主题 下一主题

删除隐藏行列及删除打印区域外的内容

[复制链接]
跳转到指定楼层
1#
发表于 2015-1-7 15:35:54 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
大家好,如何下面程序中增加“删除隐藏行列及删除打印区域外的内容”功能,隐藏行列数量位置不定,具体可见附件。
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

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅
2#
 楼主| 发表于 2015-1-7 19:36:59 | 只看该作者
往前顶一下
3#
 楼主| 发表于 2015-1-8 15:11:59 | 只看该作者
高手去哪儿啦
4#
 楼主| 发表于 2015-1-13 15:55:41 | 只看该作者
再次顶,往前顶
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-1 09:31 , Processed in 0.083767 second(s), 29 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表