Knowledge/Utility·Program

엑셀vba 메일머지처럼 자동인쇄

서 태평 2019. 1. 14. 12:03

 

Option Explicit

Sub print_Of_Payment_Statement()

    Dim rngC As Range                                     '각 셀을 넣을 변수
    Dim rngIn As Range                                     '급여항목 행을 넣을 변수
    Dim rngOut As Range                                  '공제항목 행을 넣을 변수
    Dim rngEach As Range                                '급여/공제 항목의 각 셀을 넣을 변수
   
    Application.ScreenUpdating = False              '화면 업데이트 (일시)정지

    With Sheets(1)                                            '시트 1에서
        For Each rngC In .Range(.[C2], .Cells(Rows.Count, 3).End(3))
                                                                    'C열 각 셀을 순환
            Range("D13:D14").ClearContents          '기존 데이터 삭제
            Range("A16:D27").ClearContents          '기존 데이터 삭제
   
            Set rngIn = rngC.Offset(, 1).Resize(, 11)     '급여항목 영역을 변수에 넣음
            Set rngOut = rngC.Offset(, 13).Resize(, 7)  '공제항목 영역을 변수에 넣음
                   
            Range("D13") = rngC.Previous              '수령자 입력
            Range("D14") = rngC                           '직급 입력
           
            For Each rngEach In rngIn                   '급여항목 각 셀을 순환
                If Not IsEmpty(rngEach) Then           '각 셀값이 비어 있지 않다면
                    Range("A28").End(3)(2) = .Cells(1, rngEach.Column)  '급여항목을 셀에 입력
                    Range("B28").End(3)(2) = rngEach   '급여금액을 셀에 입력
                End If
            Next rngEach
           
            For Each rngEach In rngOut                 '공제항목 각 셀을 순환
                If Not IsEmpty(rngEach) Then           '각 셀값이 비어있지 않다면
                    Range("C28").End(3)(2) = .Cells(1, rngEach.Colu mn) '공제항목을 셀에 입력
                    Range("D28").End(3)(2) = rngEach  '공제내역을 셀에 입력
                End If
            Next rngEach
           
            ActiveSheet.PrintPreview                      '각 시트 인쇄 미리보기
            'Activesheet.PrintOut                            '각 시트를 출력(인쇄 시 윗행 삭제후 이행을 사용)
        Next rngC
   
    End With
   
    Set rngIn = Nothing                                      '개체변수들 초기화(메모리 비우기)
    Set rngOut = Nothing
End Sub