zoukankan      html  css  js  c++  java
  • 复制可见区域到新表

    Sub CopyVisibleToNewSheet()
        Dim Wb As Workbook
        Dim Sht As Worksheet
        Dim NewSht As Worksheet
        Dim Rng As Range
        Set Wb = Application.ThisWorkbook
        Set Sht = Wb.ActiveSheet
        With Sht
            Set Rng = .UsedRange.SpecialCells(xlCellTypeVisible)
            Debug.Print Rng.Address
        End With
        Set NewSht = Wb.Worksheets.Add(After:=Wb.Worksheets(Wb.Worksheets.Count))
        NewSht.Name = "复制可见单元格" & Wb.Worksheets.Count
        Rng.Copy NewSht.Range("A1")
        A4PageSetup NewSht
        Set Wb = Nothing
        Set Sht = Nothing
        Set Rng = Nothing
        Set NewSht = Nothing
    End Sub
    Private Sub A4PageSetup(ByVal Sht)
        Application.PrintCommunication = False
        Dim Rng As Range
        With Sht
            Set Rng = .UsedRange
            SetCenters Rng
        End With
        With Sht.PageSetup
            .PrintTitleRows = ""
            .PrintTitleColumns = ""
            .PrintArea = Rng.Address
            .LeftMargin = Application.InchesToPoints(0.236220472440945)
            .RightMargin = Application.InchesToPoints(0.236220472440945)
            .TopMargin = Application.InchesToPoints(0.590551181102362)
            .BottomMargin = Application.InchesToPoints(0.590551181102362)
            .HeaderMargin = Application.InchesToPoints(0.31496062992126)
            .FooterMargin = Application.InchesToPoints(0.31496062992126)
            .PrintComments = xlPrintNoComments
            .CenterHorizontally = True '水平居中
            .CenterVertically = True '垂直居中
            .Orientation = xlPortrait '纵向
            .PaperSize = xlPaperA4 '纸张大小
            .FirstPageNumber = xlAutomatic
            .Order = xlDownThenOver
            .BlackAndWhite = True
            .FitToPagesWide = 1 '一页宽度
            .FitToPagesTall = 1 '一页高度
            .PrintErrors = xlPrintErrorsDisplayed
            .ScaleWithDocHeaderFooter = True
            .AlignMarginsHeaderFooter = True
        End With
        Set Rng = Nothing
        Application.PrintCommunication = True
    End Sub
    Private Sub SetCenters(ByVal Rng As Range)
        With Rng
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Columns.AutoFit
        End With
    End Sub
    

      

  • 相关阅读:
    YTU 2959: 代码填充--雨昕学矩阵
    YTU 2958: 代码填充--雨昕学画画
    YTU 2960: 改错题--小鼠标,你要干什吗?
    YTU 2975: 我的编号
    YTU 2979: MathBook类--多态
    linux命令学习:echo详解,格式化输出,不换行输出
    linux shell date 时间运算以及时间差计算方法
    C语言中mktime函数功能及用法
    Posix线程编程指南(3)
    Posix线程编程指南(2)
  • 原文地址:https://www.cnblogs.com/nextseven/p/11790312.html
Copyright © 2011-2022 走看看