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
    

      

  • 相关阅读:
    POJ 3710 Christmas Game#经典图SG博弈
    POJ 2599 A funny game#树形SG(DFS实现)
    POJ 2425 A Chess Game#树形SG
    LeetCode Array Easy 122. Best Time to Buy and Sell Stock II
    LeetCode Array Easy121. Best Time to Buy and Sell Stock
    LeetCode Array Easy 119. Pascal's Triangle II
    LeetCode Array Easy 118. Pascal's Triangle
    LeetCode Array Easy 88. Merge Sorted Array
    ASP.NET MVC 学习笔记之 MVC + EF中的EO DTO ViewModel
    ASP.NET MVC 学习笔记之面向切面编程与过滤器
  • 原文地址:https://www.cnblogs.com/nextseven/p/7833714.html
Copyright © 2011-2022 走看看