Viết Macro in sổ cái

[Thien]

Đúng rùi mình muốn thêm 1 command nữa khi muốn in ra giấy luôn.
Các Bạn xem có gộp code lại với nhau được không (Mong Thunghi cho phép post code lên nhen).
-

Option Explicit
Sub InNhieuSC()
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .DisplayAlerts = False
End With
Dim i As Integer, Rows As Integer
'S09.Visible = xlSheetVisible
Rows = S99.Cells(2, 3).Value
    For i = 1 To Rows
        S01.Range("D2").Value = Range("Dmtk").Cells(i, 1).Value
    Call InSoCaiCT
    Next i
    S09.Select
    Cells.ClearContents
    Cells.ClearFormats
    ' S09.Visible = xlSheetHidden
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .DisplayAlerts = True
End With
S01.Select
Range("d2").Select
End Sub

Sub InSoCaiCT()
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    
    S01.Range("A1").Value = "=TEN"
    S01.Range("A1").Value = S01.Range("A1").Value
    S01.Range("A2").Value = "=MST"
    S01.Range("A2").Value = S01.Range("A2").Value
    S01.Range("A3").Value = "=DC"
    S01.Range("A3").Value = S01.Range("A3").Value
    Selection.Merge True
    Range("A1:B3").Select
    Selection.Merge True
    
    S01.Range("D1009").Value = "=NGAY"
    S01.Range("D1009").Value = S01.Range("D1009").Value
    Selection.Merge True
    Range("D1015:F1009").Select
    Selection.Merge True
    
    S01.Range("C1015").Value = "=KTT"
    S01.Range("C1015").Value = S01.Range("C1015").Value
    S01.Range("D1015").Value = "=GIAMDOC"
    S01.Range("D1015").Value = S01.Range("D1015").Value
    Selection.Merge True
    Range("D1015:F1015").Select
    Selection.Merge True
      
    Dim i, HC, m As Long
    Dim TKNo As Range
    Dim TK As String
    S01.Range("E8:F8").ClearContents
    TK = Left$(S01.Range("D2"), 10)
    m = Len(S01.Range("D2"))
    HC = S00.Range("E65000").End(xlUp).Row
    i = 12
    S01.Range("A12:F1006, E1007:F1007").ClearContents ' Xoa temp
    S01.Range("A12:F1006").EntireRow.Hidden = False
    
    For Each TKNo In S00.Range("E5:E" & HC)
        If TKNo.Offset(0, -2) <= S01.Range("D4").Value And Len(TKNo) > 2 Then
            If Left$(TKNo, m) = TK Then ' No
                If TKNo.Offset(0, -2).Value < S01.Range("C4").Value Then ' Ngay nho hon
                i = i + 1
                'S01.Range("E8").Value = S01.Range("E8").Value + TKNo.Offset(0, 7).Value
                Else ' Phat Sinh
                Dim st As Long
                st = IIf(WorksheetFunction.IsText(TKNo.Offset(0, 7).Value), 0, TKNo.Offset(0, 7).Value)
                S01.Range("E8").Value = S01.Range("E8").Value + st
                'TKNo.Offset(0, 7).Value
                'S01.Range("E8").Value = S01.Range("E8").Value + TKNo.Offset(0, 7).Value
                'i = i + 1
                    S01.Range("A" & i) = TKNo.Offset(0, -3)
                    S01.Range("B" & i) = TKNo.Offset(0, -2)
                    S01.Range("C" & i) = TKNo.Offset(0, -1)
                    S01.Range("D" & i) = TKNo.Offset(0, 1)
                    S01.Range("E" & i) = TKNo.Offset(0, 7)
                End If
                i = i + 1
            ElseIf Left$(TKNo.Offset(0, 1), m) = TK Then ' Co
                If TKNo.Offset(0, -2).Value < S01.Range("C4").Value Then ' Ngay nho hon
                'S01.Range("F8").Value = S01.Range("F8").Value + TKNo.Offset(0, 7).Value
                i = i + 1
                Else ' Phat Sinh
                st = IIf(WorksheetFunction.IsText(TKNo.Offset(0, 7).Value), 0, TKNo.Offset(0, 7).Value)
                S01.Range("F8").Value = S01.Range("F8").Value + st
                'S01.Range("F8").Value = S01.Range("F8").Value + TKNo.Offset(0, 7).Value
                    'i = i + 1
                    S01.Range("A" & i) = TKNo.Offset(0, -3)
                    S01.Range("B" & i) = TKNo.Offset(0, -2)
                    S01.Range("C" & i) = TKNo.Offset(0, -1)
                    S01.Range("D" & i) = TKNo
                    S01.Range("F" & i) = TKNo.Offset(0, 7)
                End If
                i = i + 1
            End If
        End If
    Next
    'Stop
    If i > 11 Then
        S01.Range("E1007").Value = WorksheetFunction.Sum(S01.Range("E12:E" & i))
        S01.Range("F1007").Value = WorksheetFunction.Sum(S01.Range("F12:F" & i))
    End If
    If i < 20 Then i = 20
    S01.Range("A" & i + 1 & ":A1006").EntireRow.Hidden = True
    'ActiveWindow.SelectedSheets.PrintPreview
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Set TKNo = Nothing
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

Sẽ có 3 nút command: 1 là in ra sheet, 2 là in sang WB khác, 3 là in ra giấy luôn.

TC.

 

[ThuNghi]

Bạn copy code TaoNhieuSC = TaoNhieuSC_in
Code SoCaiCT =SoCaiCT_in
Thay những điều tôi nói vào TaoNhieuSC_in và SoCaiCT_in

 

[ThuNghi]

Bạn copy tòan bộ code sau vào thay thế, trừ code TaoNewWB

Option Explicit
Sub InNhieuSC()
Dim i As Integer, Rows As Integer
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .DisplayAlerts = False
End With
Rows = S99.Cells(2, 3).Value
    For i = 1 To Rows
        S01.Range("D2").Value = Range("Dmtk").Cells(i, 1).Value
        Call SoCaiCT
        ActiveWindow.SelectedSheets.PrintPreview
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
'Muốn chọn cái nào thì chọn
    Next i
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .DisplayAlerts = True
End With
S01.Select
Range("d2").Select
End Sub
Sub TaoNhieuSC()
Dim i As Integer, Rows As Integer
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .DisplayAlerts = False
End With
S09.Visible = xlSheetVisible
Rows = S99.Cells(2, 3).Value
    For i = 1 To Rows
        S01.Range("D2").Value = Range("Dmtk").Cells(i, 1).Value
        Call SoCaiCT
        Call TaoSoCai
    Next i
With S09
    .Cells.ClearContents
    .Cells.ClearFormats
    .Visible = xlSheetHidden
End With
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .DisplayAlerts = True
End With
S01.Select
Range("d2").Select
End Sub
Sub TaoSoCai()
'Xoa tmp 'unhide row to paste
With S09
    .Range("A:F").EntireRow.Hidden = False
    .Cells.ClearContents
    .Cells.ClearFormats
End With
'copy socai va dan vao tmp
    S01.Select
    Range("Socai").Select
    Selection.Copy
    S09.Select
    Range("a1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    'gan lai gia tri va xoa validation muc dich tao file chi tiet no link
    S09.Range("e7:F9").Value = S09.Range("e7:F9").Value
    S09.Range("A1:D6").Value = S09.Range("A1:D6").Value
    S09.Range("D2").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
    
    Dim i As Long
    'xac dinh dong cuoi co dl
    i = S09.Range("C1006").End(xlUp).Row
    If i < 20 Then i = 20
    'xoa dong trong ->1006 trong sh tmp
    S09.Range("A" & i + 1 & ":A1006").EntireRow.Delete Shift:=xlUp
    'tao so moi & preview
    S09.Copy After:=s98
    Sheets("tmp (2)").Select
    Sheets("tmp (2)").Name = Sheets("tmp (2)").Range("D2").Value
End Sub
Sub SoCaiCT()
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    Dim i, HC, M As Long
    Dim TKNo As Range
    Dim TK As String
    Dim ST As Long
    
    S01.Range("E8:F8").ClearContents
    TK = Left$(S01.Range("D2"), 10)
    M = Len(S01.Range("D2"))
    HC = S00.Range("E65000").End(xlUp).Row
    i = 12
    S01.Range("A12:F1006, E1007:F1007").ClearContents ' Xoa temp
    S01.Range("A12:F1006").EntireRow.Hidden = False
    
    For Each TKNo In S00.Range("E5:E" & HC)
        If TKNo.Offset(0, -2) <= S01.Range("D4").Value And Len(TKNo) > 2 Then
            If Left$(TKNo, M) = TK Or Left$(TKNo.Offset(0, 1), M) = TK Then ' No Co =TK
                If TKNo.Offset(0, -2).Value < S01.Range("C4").Value Then ' Ngay nho hon
                    i = i + 1
                Else ' Phat Sinh
                    ST = IIf(WorksheetFunction.IsText(TKNo.Offset(0, 7).Value), 0, TKNo.Offset(0, 7).Value)
                    With S01
                        .Range("A" & i & ":C" & i).Value = Range(TKNo.Offset(0, -3), TKNo.Offset(0, -1)).Value
                    End With
                    'sotien - TKDU
                With S01
                        If Left$(TKNo, M) = TK Then
                            .Range("D" & i) = TKNo.Offset(0, 1)
                            .Range("E8").Value = S01.Range("E8").Value + ST
                            .Range("E" & i) = TKNo.Offset(0, 7)
                        Else
                            .Range("D" & i) = TKNo
                            .Range("F8").Value = S01.Range("F8").Value + ST
                            .Range("F" & i) = TKNo.Offset(0, 7)
                        End If
                    End With
                End If
                i = i + 1
            End If
        End If
    Next
    If i > 11 Then
        S01.Range("E1007").Value = WorksheetFunction.Sum(S01.Range("E12:E" & i))
        S01.Range("F1007").Value = WorksheetFunction.Sum(S01.Range("F12:F" & i))
    End If
    If i < 20 Then i = 20
    S01.Range("A" & i + 1 & ":A1006").EntireRow.Hidden = True
    Set TKNo = Nothing
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub