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