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
    

      

  • 相关阅读:
    第四次实验报告
    第三次实验报告
    第五章循环结构课后反思
    第二次实验报告
    第一次实验报告
    第一次作业
    第九章 结构体与共用体
    第八章实验报告
    第七章数组实验
    第六章函数与宏定义实验报告(2)
  • 原文地址:https://www.cnblogs.com/nextseven/p/7833714.html
Copyright © 2011-2022 走看看