Dim DaChon As Byte
Private Sub ApplyPageSetup_Click()
Dim k As Byte
Dim Tren As Single, Duoi As Single, Trai As Single, Phai As Single
If DonVi.Value = "cm" Then
If Len(LeTren.Value) = 0 Then Tren = 1 Else Tren = Replace(LeTren, ".", ",")
If Len(LeDuoi.Value) = 0 Then Duoi = 1 Else Duoi = Replace(LeDuoi, ".", ",")
If Len(LeTrai.Value) = 0 Then Trai = 4 Else Trai = Replace(LeTrai, ".", ",")
If Len(LePhai.Value) = 0 Then Phai = 1 Else Phai = Replace(LePhai, ".", ",")
Else
If Len(LeTren.Value) = 0 Then Tren = 0.3 Else Tren = Replace(LeTren, ".", ",")
If Len(LeDuoi.Value) = 0 Then Duoi = 0.3 Else Duoi = Replace(LeDuoi, ".", ",")
If Len(LeTrai.Value) = 0 Then Trai = 0.9 Else Trai = Replace(LeTrai, ".", ",")
If Len(LePhai.Value) = 0 Then Phai = 0.3 Else Phai = Replace(LePhai, ".", ",")
End If
k = 0
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then k = k + 1
Next
Dim Tam As String
Tam = Me.KhoGiay.Caption
Application.ScreenUpdating = False
Application.PrintCommunication = False
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
Me.PhanTram.Width = 58
Me.Bar.Width = Me.Bar.Width + (150 / k)
If Round(100 * Me.Bar.Width / 150, 1) >= 100 Then _
Me.PhanTram.Width = 0 _
Else _
: Me.PhanTram.Caption = Round(100 * Me.Bar.Width / 150, 1) & "%"
'Me.PhanTram.Caption = Round(100 * Me.Bar.Width / 150, 1) & "%"
DoEvents
With Worksheets(ListBox1.List(i)).PageSetup
If DonVi.Value = "inch" Then
.LeftMargin = Application.InchesToPoints(Trai)
.RightMargin = Application.InchesToPoints(LPhai)
.TopMargin = Application.InchesToPoints(Tren)
.BottomMargin = Application.InchesToPoints(Duoi)
Else
.LeftMargin = Application.CentimetersToPoints(Trai)
.RightMargin = Application.CentimetersToPoints(Phai)
.TopMargin = Application.CentimetersToPoints(Tren)
.BottomMargin = Application.CentimetersToPoints(Duoi)
End If
[COLOR=#ff0000]If Len(InTieuDe.Value) = 0 Then GoTo BoQua
Sh = Mid(InTieuDe, 1, Application.WorksheetFunction.Find("!", InTieuDe))
Vug = Mid(InTieuDe, Application.WorksheetFunction.Find("!", InTieuDe) + 1, Len(InTieuDe) - Len(Sh))
Arr = "QWERTYUIOPASDFGHJKLZXCVBNMqwertyuiopasdfghjklzxcvbnm!"
For x = 0 To Len(Arr) - 1
Vug = Replace(Vug, Mid(Arr, x + 1, 1), "")
Next x
VungInTieuDe = Sh & Replace(Vug, "$$", "$")
.PrintTitleRows = VungInTieuDe
InTieuDe = VungInTieuDe
BoQua:
[/COLOR]
If InNhuHienThi.Value = True Then
.PrintComments = xlPrintInPlace
Else
.PrintComments = xlPrintNoComments
End If
tmp = KhoGiay.Caption
.PaperSize = Switch(tmp = "A3", xlPaperA3, tmp = "A4", xlPaperA4, tmp = "A5", xlPaperA5, _
tmp = "A6", 70, tmp = "B4", 127, tmp = "B5", 128, tmp = "", xlPaperLetter)
If Ngang.Value Then
.Orientation = xlLandscape
Else
.Orientation = xlPortrait
End If
End With
End If
Next i
Me.Bar.Width = 0
Me.PhanTram.Width = 0
Me.KhoGiay.Caption = Tam
DaChon = 0
Application.PrintCommunication = True
Application.ScreenUpdating = True
End Sub
Private Sub ChuThich()
NutHienThi.ControlTipText = "Nh" & ChrW(7845) & "n v" & ChrW(224) & "o " & ChrW(273) & _
ChrW(7875) & " hi" & ChrW(7875) & "n th" & ChrW(7883) & " c" & ChrW(225) & "c trang t" & ChrW(237) & "nh " _
& ChrW(273) & ChrW(432) & ChrW(7907) & "c ch" & ChrW(7885) & "n"
NutAn.ControlTipText = "Nh" & ChrW(7845) & "n v" & ChrW(224) & "o " & ChrW(273) & _
ChrW(7875) & " " & ChrW(7849) & "n c" & ChrW(225) & "c trang t" & ChrW(237) & "nh " & ChrW(273) & _
ChrW(432) & ChrW(7907) & "c ch" & ChrW(7885) & "n"
NutSieuAn.ControlTipText = "Nh" & ChrW(7845) & "n v" & ChrW(224) & "o " & ChrW(273) & _
ChrW(7875) & " si" & ChrW(234) & "u " & ChrW(7849) & "n c" & ChrW(225) & "c trang t" & ChrW(237) & "nh " _
& ChrW(273) & ChrW(432) & ChrW(7907) & "c ch" & ChrW(7885) & "n" & ChrW(10) & " (C" & _
ChrW(225) & "c Sheets n" & ChrW(224) & "y s" & ChrW(7869) & " kh" & ChrW(244) & _
"ng th" & ChrW(7875) & " d" & ChrW(249) & "ng l" & ChrW(7879) & "nh Unhide " & _
ChrW(273) & ChrW(7875) & " hi" & ChrW(7875) & "n th" & ChrW(7883) & " l" & ChrW(7841) _
& "i " & ChrW(273) & ChrW(432) & ChrW(7907) & "c)"
NutKhoiPhuc.ControlTipText = "Nh" & ChrW(7845) & "n v" & ChrW(224) & "o " & ChrW(273) & ChrW(7875) & " kh" & _
ChrW(244) & "i bi" & ChrW(234) & "n b" & ChrW(7843) & "n nh" & ChrW(432) & " ban " & ChrW(273) & ChrW(7847) & "u"
NutDiDen.ControlTipText = "Nh" & ChrW(7845) & "n v" & ChrW(224) & "o " & ChrW(273) & ChrW(7875) & _
" " & ChrW(273) & "i " & ChrW(273) & ChrW(7871) & "n trang t" & ChrW(237) & "nh " & _
ChrW(273) & ChrW(227) & " ch" & ChrW(7885) & "n"
Me.ListBox1.ControlTipText = "Nh" & ChrW(7845) & "n gi" & ChrW(7919) & _
"a phím Ctrl + Click chu" & ChrW(7897) & "t " & ChrW(273) & ChrW(7875) & " ch" & _
ChrW(7885) & "n nhi" & ChrW(7873) & "u " & ChrW(273) & ChrW(7889) & "i t" & ChrW(432) _
& ChrW(7907) & "ng"
Me.LamMoi.ControlTipText = "Nh" & ChrW(7845) & "n v" & ChrW(224) & "o " & ChrW(273) & _
ChrW(7875) & " l" & ChrW(224) & "m m" & ChrW(7899) & "i danh s" & ChrW(225) & "ch"
Me.XemTatca.ControlTipText = "Ch" & ChrW(7885) & "n " & ChrW(273) & _
ChrW(7875) & " xem c" & ChrW(225) & "c trang t" & ChrW(237) & "nh c" & ChrW(243) & _
" trong file hi" & ChrW(7879) & "n h" & ChrW(224) & "nh"
Me.XemSheetHien.ControlTipText = "Ch" & ChrW(7885) & "n " & ChrW(273) & ChrW(7875) & _
" xem c" & ChrW(225) & "c trang t" & ChrW(237) & "nh " & ChrW(273) & "ang kh" & _
ChrW(244) & "ng b" & ChrW(7883) & " " & ChrW(7849) & "n"
Me.XemSheetAn.ControlTipText = "Ch" & ChrW(7885) & "n " & ChrW(273) _
& ChrW(7875) & " xem c" & ChrW(225) & "c trang t" & ChrW(237) & "nh b" & ChrW(7883) & _
" " & ChrW(7849) & "n"
Me.XemSheetSieuAn.ControlTipText = "Ch" & ChrW(7885) & "n " & _
ChrW(273) & ChrW(7875) & " xem c" & ChrW(225) & "c trang t" & ChrW(237) & "nh b" & _
ChrW(7883) & " " & ChrW(7849) & "n (Kh" & ChrW(244) & "ng th" & ChrW(7875) & " b" & _
ChrW(7887) & " " & ChrW(7849) & "n b" & ChrW(7857) & "ng l" & ChrW(7879) & "nh th" & _
ChrW(244) & "ng th" & ChrW(432) & ChrW(7901) & "ng)"
End Sub
Private Sub DangBangTinh_Change()
ListBox1.Clear
If DangBangTinh.Value = " Bi" & ChrW(234) & "n b" & ChrW(7843) & "n" Then 'neu chon xem bien ban
For Each Sheet In Worksheets
i = i + 1
If Left$(Sheets(i).Name, 2) = "BB" Then ListBox1.AddItem Application.Sheets(i).Name
Next
ElseIf DangBangTinh.Value = " Ph" & ChrW(7909) & " l" & ChrW(7909) & "c" Then 'neu chon xem phu luc
For Each Sheet In Worksheets
i = i + 1
If Left$(Sheets(i).Name, 3) = "Phu" Then ListBox1.AddItem Application.Sheets(i).Name
Next
ElseIf DangBangTinh.Value = " S" & ChrW(7893) & " " & ChrW(273) & "o" Then 'neu chon xem so do
For Each Sheet In Worksheets
i = i + 1
If Left$(Sheets(i).Name, 3) = "SoD" Then ListBox1.AddItem Application.Sheets(i).Name
Next
ElseIf DangBangTinh.Value = " Phi" & ChrW(7871) & "u c" & ChrW(244) & "ng t" & ChrW(225) & "c" Then 'neu chon xem phieu cong tac
For Each Sheet In Worksheets
i = i + 1
If Left$(Sheets(i).Name, 3) = "Phi" Then ListBox1.AddItem Application.Sheets(i).Name
Next
ElseIf DangBangTinh.Value = " S" & ChrW(7889) & " li" & ChrW(7879) & "u" Then 'neu chon xem so lieu
For Each Sheet In Worksheets
i = i + 1
If Left$(Sheets(i).Name, 3) = "SoL" Then ListBox1.AddItem Application.Sheets(i).Name
Next
ElseIf DangBangTinh.Value = " Thông tin" Then 'neu chon xem thong tin
For Each Sheet In Worksheets
i = i + 1
If Left$(Sheets(i).Name, 2) <> "BB" And _
Left$(Sheets(i).Name, 3) <> "Phu" And _
Left$(Sheets(i).Name, 3) <> "SoD" And _
Left$(Sheets(i).Name, 3) <> "Phi" And _
Left$(Sheets(i).Name, 3) <> "SoL" Then ListBox1.AddItem Application.Sheets(i).Name
Next
End If
End Sub
Private Sub DonVi_Change()
LeTrai = ""
LePhai = ""
LeTren = ""
LeDuoi = ""
End Sub
Private Sub InTieuDe_DropButtonClick()
DaChon = 1
On Error Resume Next
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
Worksheets(ListBox1.List(i)).Visible = xlSheetVisible
Worksheets(ListBox1.List(i)).Select
Exit Sub
End If
Next i
End Sub
Private Sub KhoGiay1_Click()
KhoGiayKhac = ""
End Sub
Private Sub KhoGiayKhac_Change()
KhoGiay.Caption = KhoGiayKhac.Value
End Sub
Private Sub KhoGiay_Click()
KhoGiayKhac = ""
End Sub
Private Sub KhoiPhucNgatTrang_Click()
End Sub
Private Sub LamMoi_Click()
DangBangTinh.Value = ""
If XemTatca.Value Then
Call RunTatca
ElseIf XemSheetHien.Value Then
Call RunSheetHien
ElseIf XemSheetAn.Value Then
Call RunSheetAn
ElseIf XemSheetSieuAn.Value Then
Call RunSheetSieuAn
End If
End Sub
Private Sub ListBox1_Change()
DaChon = 0
End Sub
Private Sub ListBox1_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal x As Single, _
ByVal y As Single)
HookControlScroll ListBox1
Dim SoChia As Single
If NutAnHien.Caption = "<" Then
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
With Worksheets(ListBox1.List(i)).PageSetup
If .Orientation = xlLandscape Then Ngang.Value = True Else Doc.Value = True
If .PaperSize = xlPaperA3 Then KhoGiay.Caption = "A3" Else KhoGiay.Caption = "A4"
tmp = .PaperSize
KhoGiay.Caption = Switch(tmp = 8, "A3", tmp = 9, "A4", tmp = 11, "A5", _
tmp = "70", "A6", tmp = "127", "B4", tmp = "128", "B5", tmp = 1, "")
If .PrintComments = xlPrintInPlace Then InNhuHienThi.Value = True Else InNhuHienThi.Value = False
If DonVi.Value = "inch" Then SoChia = 72 Else SoChia = 28.34
LeTren.Value = Round(.TopMargin / SoChia, 2)
LeDuoi.Value = Round(.BottomMargin / SoChia, 2)
LeTrai.Value = Round(.LeftMargin / SoChia, 2)
LePhai.Value = Round(.RightMargin / SoChia, 2)
If DaChon = 0 Then InTieuDe.Value = .PrintTitleRows
End With
Exit Sub
End If
Next i
Else
End If
End Sub
Private Sub NutAnHien_Click()
If NutAnHien.Caption = ">" Then
NutAnHien.Caption = "<"
Me.Width = 483
Me.Bar.Width = 0
Me.PhanTram.Width = 0
Else
NutAnHien.Caption = ">"
Me.Width = 316
End If
End Sub
Private Sub NutAn_Click()
On Error Resume Next
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then Worksheets(ListBox1.List(i)).Visible = _
xlSheetHidden
Next i
Call XoaItem
If SelectAll.Value = True Then
Worksheets("Menus").Visible = xlSheetVisible
Worksheets(ActiveSheet.Name).Visible = xlSheetVeryHidden
End If
SelectAll.Value = False
End Sub
Private Sub NutDiDen_Click()
On Error Resume Next
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
Worksheets(ListBox1.List(i)).Visible = xlSheetVisible
Worksheets(ListBox1.List(i)).Select
Exit Sub
End If
Next i
End Sub
Private Sub NutHienThi_Click()
On Error Resume Next
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then Worksheets(ListBox1.List(i)).Visible = _
xlSheetVisible
Next i
Call XoaItem
SelectAll.Value = False
End Sub
Private Sub NutHuybo_Click()
On Error Resume Next
Unload Me
End Sub
Private Sub NutKhoiPhuc_Click()
Dim x As Byte
Dim i As Byte
Dim k As Integer
Dim OK As Byte
OK = 0
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
If OK = 1 Then GoTo TiepTuc
x = UniBox("Thông báo", "B" & ChrW(7841) & "n ch" & ChrW(7855) & _
"c ch" & ChrW(7855) & "n mu" & ChrW(7889) & "n kh" & _
ChrW(244) & "i ph" & ChrW(7909) & "c l" & ChrW(7841) & _
"i?" & ChrW(10) & "T" & ChrW(7845) & "t c" & ChrW(7843) & _
" thay " & ChrW(273) & ChrW(7893) & "i s" & ChrW(7869) & _
" " & ChrW(273) & ChrW(432) & ChrW(7907) & "c kh" & _
ChrW(244) & "i ph" & ChrW(7909) & "c l" & ChrW(7841) & _
"i nh" & ChrW(432) & " ban " & ChrW(273) & ChrW(7847) & "u." _
, 1, 2)
If x <> 1 Then Exit Sub Else OK = 1
End If
Next i
TiepTuc:
On Error Resume Next
k = 0
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
Application.Run ListBox1.List(i)
k = k + 1
End If
Next i
If (ListBox1.ListCount > 0) And (k = 0) Then UniBox _
"Thông báo", "B" & ChrW(7841) & "n ch" & ChrW(432) & _
"a ch" & ChrW(7885) & "n Bi" & ChrW(234) & "n b" & _
ChrW(7843) & "n c" & ChrW(7847) & "n kh" & ChrW(244) & _
"i ph" & ChrW(7909) & "c", 0, 1
Call XoaItem
UniBox "Thông báo", "Bi" & ChrW(234) & "n b" & ChrW(7843) & "n " & ChrW(273) & ChrW(227) & " kh" & ChrW(244) & "i ph" & ChrW(7909) & "c l" & ChrW(7841) & "i ban " & ChrW(273) & ChrW(7847) & "u!", 0, 4
SelectAll.Value = False
End Sub
Private Sub NutSieuAn_Click()
On Error Resume Next
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then Worksheets(ListBox1.List(i)).Visible = _
xlSheetVeryHidden
Next i
Call XoaItem
If SelectAll.Value = True Then
Worksheets("Menus").Visible = xlSheetVisible
Worksheets(ActiveSheet.Name).Visible = xlSheetVeryHidden
End If
SelectAll.Value = False
End Sub
Private Sub RunSheetAn()
On Error Resume Next
ListBox1.Clear
For Each Sheet In Worksheets
i = i + 1
If (Application.Sheets(i).Visible = xlSheetHidden) Then ListBox1.AddItem _
Application.Sheets(i).Name
Next
SelectAll.Value = False
End Sub
Private Sub RunSheetHien()
On Error Resume Next
ListBox1.Clear
For Each Sheet In Worksheets
i = i + 1
If (Application.Sheets(i).Visible = xlSheetVisible) Then ListBox1.AddItem _
Application.Sheets(i).Name
Next
SelectAll.Value = False
End Sub
Private Sub RunSheetSieuAn()
On Error Resume Next
ListBox1.Clear
For Each Sheet In Worksheets
i = i + 1
If (Application.Sheets(i).Visible = xlSheetVeryHidden) Then ListBox1.AddItem _
Application.Sheets(i).Name
Next
SelectAll.Value = False
End Sub
Private Sub RunTatca()
On Error Resume Next
ListBox1.Clear
For Each Sheet In Worksheets
i = i + 1
If (Application.Sheets(i).Visible = xlSheetVisible) Or _
(Application.Sheets(i).Visible = xlSheetVeryHidden) Or _
(Application.Sheets(i).Visible = xlSheetHidden) Then _
ListBox1.AddItem Application.Sheets(i).Name
Next
SelectAll.Value = False
End Sub
Private Sub SelectAll_Click()
'bo chon/ chon tat ca
If SelectAll.Value = True Then
For i = 0 To ListBox1.ListCount - 1
ListBox1.Selected(i) = True
Next i
End If
If SelectAll.Value = False Then
For i = 0 To ListBox1.ListCount - 1
ListBox1.Selected(i) = False
Next i
End If
End Sub
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = ""
i = 0
For Each Sheet In Worksheets
i = i + 1
If (Application.Sheets(i).Visible = xlSheetVisible) Or _
(Application.Sheets(i).Visible = xlSheetVeryHidden) Or _
(Application.Sheets(i).Visible = xlSheetHidden) Then ListBox1.AddItem _
Application.Sheets(i).Name
Next
Dim Arr()
Arr = Array(" Thông tin", " Bi" & ChrW(234) & "n b" & ChrW(7843) & "n", _
" Ph" & ChrW(7909) & " l" & ChrW(7909) & "c", _
" S" & ChrW(7893) & " " & ChrW(273) & "o", _
" Phi" & ChrW(7871) & "u c" & ChrW(244) & "ng t" & ChrW(225) & "c", _
" S" & ChrW(7889) & " li" & ChrW(7879) & "u")
Me.DangBangTinh.List = Arr
Dim Arr2()
Arr2 = Array("cm", "inch")
Me.DonVi.List = Arr2
Arr3 = Array("A3", "A4", "A5", "A6", "B4", "B5", "")
Me.KhoGiayKhac.List = Arr3
Call ChuThich
DaChon = 0
Me.Width = 316
Me.Frame2.Caption = ChrW(272) & ChrW(7883) & "nh d" & ChrW(7841) & "ng"
End Sub
Private Sub UserForm_Terminate()
UnhookControlScroll
End Sub
Private Sub XemSheetAn_Click()
RunSheetAn
End Sub
Private Sub XemSheetHien_Click()
RunSheetHien
End Sub
Private Sub XemSheetSieuAn_Click()
RunSheetSieuAn
End Sub
Private Sub XemTatca_Click()
RunTatca
End Sub
Private Sub XoaItem()
Dim counter As Integer
counter = 0
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i - counter) Then
ListBox1.RemoveItem (i - counter)
counter = counter + 1
End If
Next i
End Sub