zoukankan      html  css  js  c++  java
  • 20171114xlVba选定单行记录并打印

    Public Sub PrintSelectRow()
        Dim Wb As Workbook
        Dim iSht As Worksheet
        Dim rSht As Worksheet
        Dim pSht As Worksheet
        Dim Rng As Range, ActiveRow As Long
        Dim Arr As Variant, Ar As Variant
        Dim EndRow As Long, EndCol As Long
        Dim RngCol As Long
        Set Wb = Application.ThisWorkbook
        Set iSht = Wb.Worksheets("信息表")
        Set rSht = Wb.Worksheets("打印记录")
        Set pSht = Wb.Worksheets("打印模板")
        
        With iSht
            EndCol = .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column
            ActiveRow = Application.ActiveCell.Row
            Set Rng = .Range(.Cells(ActiveRow, 1), .Cells(ActiveRow, EndCol))
            RngCol = EndCol + 1
            If Application.WorksheetFunction.CountA(Rng) = 0 Then
                MsgBox "当前选中行为空白行,请重新选择!", vbInformation, "AuthorQQ 84857038"
                GoTo ErrorExit
            End If
            Ar = Rng.Value
        End With
        
        With rSht
            EndRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
            If EndRow < 1 Then
                MsgBox "请在打印记录表第一行添加标题!", vbInformation, "AuthorQQ 84857038"
                GoTo ErrorExit
            End If
            
            Set Rng = .Range(.Cells(2, 1), .Cells(EndRow + 1, RngCol))
            Arr = Rng.Value
            For i = UBound(Arr) To LBound(Arr) + 1 Step -1
                For j = LBound(Arr, 2) To UBound(Arr, 2)
                    Arr(i, j) = Arr(i - 1, j)
                Next j
            Next i
            
            i = 1
            Arr(1, 1) = EndRow
            For j = LBound(Ar) To UBound(Ar)
                Arr(1, j + 1) = Ar(1, j)
            Next j
            Rng.Value = Arr
            SetBorders .UsedRange
            SetFormat .UsedRange
        End With
        
        pSht.PrintOut
        
    ErrorExit:
        Set iSht = Nothing
        Set rSht = Nothing
        Set pSht = Nothing
        Set Rng = Nothing
        Set Wb = Nothing
        
    End Sub
    Private Sub SetBorders(ByVal Rng As Range)
        With Rng.Borders
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
    End Sub
    Private Sub SetFormat(ByVal Rng As Range)
        With Rng
            With .Font
                .Size = 11
                .Name = "宋体"
            End With
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Columns.AutoFit
        End With
    End Sub
    

      

  • 相关阅读:
    Redis订阅和发布模式和Redis事务
    Redis介绍和环境安装
    Redis基本数据类型
    MongoDB导入导出以及数据库备份
    MongoDB-python的API手记
    MongoDB对应SQL语句
    判断是否微信浏览器访问并得到微信版本号
    windows 下编译php扩展库pecl里的扩展memcache
    用PHPExcel类读取excel文件的内容
    用excel.php类库导出excel文件
  • 原文地址:https://www.cnblogs.com/nextseven/p/7833714.html
Copyright © 2011-2022 走看看