Sub [COLOR=#ff0000]GPE_InsertPageBreak[/COLOR]()
Dim vung As Range, rng As Range
Application.ScreenUpdating = False
With Sheets("Sheet1")
.Select
.PageSetup.PrintArea = ""
.ResetAllPageBreaks
Set vung = .Range(.[A1048576].End(xlUp), .[A1])
End With
'tim` Header THE KHO
For Each rng In vung
If rng = Sheets("GPE").Range("H1") Then
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=rng
End If
Next
Range("A1").Select
ActiveWindow.ScrollRow = 1
Application.ScreenUpdating = True
End Sub
Sub [COLOR=#ff0000]GPE_FindPrintArea[/COLOR]()
'ko the dung` Phuong thuc Find do Merge Cells
Dim ws1 As Worksheet, ws2 As Worksheet
Dim vung1 As Range, vung2 As Range, tenVT As Range, KTT As Range
Dim rng As Range, n As Long, m As Long
Application.ScreenUpdating = False
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("GPE")
With ws1
Set vung1 = .Range(.[A1048576].End(xlUp), .[A1])
Set vung2 = .Range(.[H1048576].End(xlUp), .[H1])
End With
With ws2
Set tenVT = .Range("B1")
Set KTT = .Range("D1")
.Range("B3:F1000").ClearContents
End With
'tim` ten Vat Tu*
For Each rng In vung1
If rng Like tenVT.Value & "*" Then
ws2.Range("B" & 3 + n) = rng.Value
ws2.Range("C" & 3 + n) = rng.Offset(-5).Address
n = n + 1
End If
Next
'tim Ke Toan Truong, tao. Print Area, Pages
For Each rng In vung2
If rng = KTT.Value Then
ws2.Range("D" & 3 + m) = rng.Offset(1, 1).Address
ws2.Range("E" & 3 + m).FormulaR1C1 = "=RC[-2]&"":""&RC[-1]" 'record Macro
'Set Print Area cho sheet1 truoc khi lay' .Pages.Count
ws1.PageSetup.PrintArea = ws2.Range("E" & 3 + m).Value
ws2.Range("F" & 3 + m) = (Sheets(ws1.Name).PageSetup.Pages.Count)
m = m + 1
End If
Next
Application.ScreenUpdating = True
End Sub
,
