Chào các anh chị trong diễn đàn
tôi có form vba như hình ảnh attach
Có mấy vấn đề muốn được diễn đàn giúp đỡ và hướng dẫn:
- Tôi muốn tùy chình kích thước các Label như hình là số đến; loại văn bản ...
- Tạo ScrollBar dọc và ngang (do dữ liệu khi hiển thị nhiều) riêng đối với ScrollBar dọc thì dùng chuột giữa để lăn và xem vùng dữ liệu.
Dưới đây là code của form này
Chân thành cảm ơn diễn đàn rất nhiều
Option Explicit
'Khai báo API
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_THICKFRAME = &H40000
Private Const WS_SIZEBOX = WS_THICKFRAME
'Khai báo bie^'n cho form
Dim hwnd&, PrevStyle&
Dim OldWidth As Double, OldHeight As Double
Dim cn As Object, rs As Object
Private MyControls()
Private sArr()
Dim Item As Integer
Dim duongdan As Long
Dim fluu As String
Dim Vfile, file As String
Private Sub cb_luu_Change()
Dim strDK0 As String
strDK0 = Trim(Me.cb_luu.Value)
If Me.cb_luu.Value = "Null" Then
Range("TrackLuuFile").Value = strDK0
Else
Range("TrackLuuFile").Value = ""
End If
'---------------------
On Error GoTo thoat
Range("AllTHDataDen").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"Crit"), CopyToRange:=Range("Ext"), Unique:=False
Me.ListBox1.RowSource = "FilterTHDataDen"
thoat: Exit Sub
End Sub
Private Sub cb_luufile_DropButtonClick()
Dim loaivb, tenfile As String
Vfile = Application.GetOpenFilename("All Files, *.xls;*.xlsx;*.xlsm; *.docx; *.doc; *.pdf; *.rar; *.zip")
If TypeName(Vfile) = "String" Then cb_luufile.Text = Vfile
cb_luufile.Enabled = False
cb_luufile.Enabled = True
tenfile = Mid(Vfile, InStrRev(Vfile, "\") + 1)
'txt_backupfile.Text = ThisWorkbook.Path & "\Den\" & tenfile
'txt_backupfile.Text = tenfile
'loaivb = Range("Data!C" & irow).Value
txt_backupfile.Text = "\" & duongdan & "\Den\" & fluu & "\" & tenfile
End Sub
Private Sub cmd_guimail_Click()
Dim irow As Long
Sheet11.Visible = xlSheetVisible
Range("Index!O13").Value = "FormNhap"
Range("Index!item").Value = Me.ListBox1.Column(0)
' duongdan = Range("Index!L4")
' Sheet11.ShowDataForm
Range("AllTHDataDen").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"Crit"), CopyToRange:=Range("Ext"), Unique:=False
Me.ListBox1.RowSource = "FilterTHDataDen"
irow = Range("Index!item").Value + 2
Sheet11.Select
Sheet11.[F13].Value = Range("THDataDen!H" & irow).Value
If Range("THDataDen!P" & irow).Value <> "" Then
Sheet11.[F11].Value = ThisWorkbook.Path & Range("THDataDen!P" & irow).Value
Else
Sheet11.[F11].Value = ""
End If
HideFrm
'FormNhap.Hide
frmMail.Show
End Sub
Private Sub CmdSua_Click()
LOAD_Den_NAM
Range("Index!item").Value = Me.ListBox1.Column(0)
'Range("Index!item").Value = Me.ListBox1.ListIndex + 1
HideFrm
FormSua.Show
Range("AllTHDataDen").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"Crit"), CopyToRange:=Range("Ext"), Unique:=False
' Me.ListBox1.RowSource = "FilterTHDataDen"
End Sub
Private Sub CmdThoat_Click()
Range("Index!N4").ClearContents
Range("LOCDEN!Y2:AF2").ClearContents
Unload Me
End Sub
Private Sub cmdxemden_Click()
file = ThisWorkbook.Path & Me.ListBox1.Column(15)
'link = ThisWorkbook.Path & "\Den\" & Me.ListBox1.Column(15)
If file = "" Then
Msg "File hie65n ta5i kho6ng co1 trong thu7 mu5c Den!" & vbCrLf & vbCrLf & _
"Vui lo2ng lu7u file va2o thu7 mu5c Den", vbInformation
' FormND.Show
ElseIf Dir(file) <> "" Then
With CreateObject("Shell.Application")
.Open (file)
End With
Else
Msg "File " & file & " hie65n ta5i kho6ng co1 trong thu7 mu5c Den!" & vbCrLf & vbCrLf & _
"Vui lo2ng lu7u file va2o thu7 mu5c Den vo71i te6n la2: " & file, vbInformation
'FormND.Show
End If
End Sub
Private Sub CmdLich_Click()
Dim t As Double, L As Double, E As Double
E = (Width - InsideWidth) / 2
t = Top + Height - InsideHeight '- E
L = Left + E
With UsfCalendar
.StartUpPosition = 0
.Top = t + TextBox5.Top + TextBox5.Height
.Left = L + TextBox5.Left
End With
With TextBox5
.Text = DatePicked(.Value)
.SetFocus
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub
Private Sub CmdXem_Click()
Range("Index!item").Value = Me.ListBox1.ListIndex + 1
FormXuLy.Show
Range("AllTHDataDen").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"Crit"), CopyToRange:=Range("Ext"), Unique:=False
Me.ListBox1.RowSource = "FilterTHDataDen"
'LOAD_Den_NAM
'FormSua.Show
' Range("AllTHDataDen").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"Crit"), CopyToRange:=Range("Ext"), Unique:=False
' Me.ListBox1.RowSource = "FilterTHDataDen"
'Range("Index!item").Value = Me.ListBox1.Column(0)
'On Error GoTo thoat
' Select Case Me.ListBox1.Column(10)
' Case Is = Range("Index!B2")
'If Me.ListBox1.Column(10) = Range("Index!B2") Then
' FormXuly.Show
'Sheets("THDataDen").Select
'Range("THDataDen").Select
'Range("AllTHDataDen").Select
'Me.ListBox1.RowSource = "THDataDen"
'Sheets("LOCDEN").Select
'Range("FilterTHDataDen").Select
'Range("AllTHDataDen").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
'"Crit"), CopyToRange:=Range("Ext"), Unique:=False
'Me.ListBox1.RowSource = "FilterTHDataDen"
'Else
' Msg "khong bang"
'End If
'Case Is = Range("Index!B3")
'FormCapnhat.Show
' Range("AllTHDataDen").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
' "Crit"), CopyToRange:=Range("Ext"), Unique:=False
' Sheets("THDataDen").Select
' Range("THDataDen").Select
' Range("AllTHDataDen").Select
' Me.ListBox1.RowSource = "THDataDen"
' Sheets("LOCDEN").Select
' Range("FilterTHDataDen").Select
' Me.ListBox1.RowSource = "FilterTHDataDen"
'Case Is = Range("Index!B4")
' 'FormND.Show
' Range("AllTHDataDen").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
' "Crit"), CopyToRange:=Range("Ext"), Unique:=False
' Sheets("THDataDen").Select
' Range("THDataDen").Select
' Range("AllTHDataDen").Select
' Me.ListBox1.RowSource = "THDataDen"
' Sheets("LOCDEN").Select
' Range("FilterTHDataDen").Select
' Me.ListBox1.RowSource = "FilterTHDataDen"
'Case Else
'End Select
'thoat: Exit Sub
End Sub
Private Sub cmdxemdi_Click()
Dim file As String
file = Me.ListBox1.Column(14)
'link = "\Di\" & file & ".pdf"
If file = "" Then
Msg "File hie65n ta5i kho6ng co1 trong thu7 mu5c Di!" & vbCrLf & vbCrLf & _
"Vui lo2ng lu7u file va2o thu7 mu5c Di", vbInformation
ElseIf Dir(file) = Empty Then
Msg "File " & file & ".pdf" & " hie65n ta5i kho6ng co1 trong thu7 mu5c Di!" & vbCrLf & vbCrLf & _
"Vui lo2ng lu7u file va2o thu7 mu5c Di vo71i te6n la2: " & file & ".pdf", vbInformation
Else
With CreateObject("Shell.Application")
.Open (file)
End With
End If
End Sub
Private Sub ComboBox2_Click()
Dim dk As String
Dim ham As WorksheetFunction
Set ham = Application.WorksheetFunction
dk = Me.ComboBox2.Value
fluu = ham.VLookup(dk, Range("VloaiVB"), 3, 0)
If ComboBox2.Value <> "" Then
cb_luufile.Enabled = True
End If
End Sub
Private Sub ComboBox2_Enter()
SendKeys "%{DOWN}"
End Sub
Private Sub ComboBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If ComboBox2.Value <> "" Then
cb_luufile.Enabled = True
Else
cb_luufile.Enabled = False
End If
End Sub
Private Sub ComboBox3_Change()
sArr = Sheet9.Range("CQ_NK").Value
Dim i As Integer
Dim arr()
Me.ComboBox4.Clear
For i = 1 To UBound(sArr)
If sArr(i, 1) = Me.ComboBox3.Value Then
Me.ComboBox4.AddItem sArr(i, 2)
End If
Next
End Sub
Private Sub ComboBox3_Enter()
SendKeys "%{DOWN}"
End Sub
Private Sub ComboBox4_Enter()
SendKeys "%{DOWN}"
End Sub
Private Sub CommandButton1_Click()
Range("QLCV!O40").ClearContents
Range("QLCV!O41").ClearContents
Sheet3.cb_namnhapden.Value = ""
Sheet3.cb_namlocden.Value = ""
Range("LOCDEN!Y2:AF2").ClearContents
Sheet6.Visible = xlSheetVeryHidden
Sheet8.Visible = xlSheetVeryHidden
Sheet9.Visible = xlSheetVeryHidden
Sheet12.Visible = xlSheetVeryHidden
Sheet11.Visible = xlSheetVeryHidden
Unload Me
Sheet3.Select
End Sub
Private Sub CommandButton2_Click()
'Dim ws As Worksheet
'Set ws = Worksheets("Data")
Me.TextBox1.Value = Range("irow").Value
Me.TextBox2.Value = ""
Me.TextBox3.Value = Format(Date, "dd/MM/yyyy")
Me.TextBox4.Value = ""
Me.TextBox5.Value = ""
Me.TextBox6.Value = ""
'Me.TextBox7.Value = ""
Me.ComboBox3.Value = ""
'Me.TextBox8.Value = ""
Me.ComboBox4.Value = ""
Me.ComboBox2.Value = ""
'Me.txttenfile.Value = ""
Me.cb_luufile.Value = ""
txt_backupfile.Value = ""
Me.TextBox2.SetFocus
Me.TextBox1.Value = Format(ListBox1.ListCount, "#,##0") + 1
Me.TextBox3.Value = Format(Date, "dd/MM/yyyy")
End Sub
Private Sub CommandButton3_Click()
Dim con As New ADODB.Connection, rs As New ADODB.Recordset, ctrl As Control
On Error Resume Next
Dim r As Integer
Dim M As String
Dim namden As Long
Dim FileNguon, FileDich
Application.ScreenUpdating = False
Application.DisplayAlerts = False
namden = Range("QLCV!O41").Value
If TextBox3.Value = "" Then
Msg "Nga2y d9e61n kho6ng d9u7o75c bo3 tro61ng", "Tho6ng ba1o"
TextBox3.SetFocus
Exit Sub
Else
If Format(Me.TextBox3.Value, "yyyy") <> namden Then
Msg "Nga2y tha1ng d9e61n kho6ng d9u1ng vo71i na8m d9a8ng ky1 co6ng va8n"
TextBox3.SetFocus
Exit Sub
End If
End If
If ComboBox2.Value = "" Then
Msg "Loa5i va8n ba3n kho6ng d9u7o75c bo3 tro61ng", "Tho6ng ba1o"
ComboBox2.SetFocus
Exit Sub
End If
If TextBox5.Value = "" Then
Msg "Nga2y tha1ng va8n ba3n kho6ng d9u7o75c bo3 tro61ng", "Tho6ng ba1o"
TextBox5.SetFocus
Exit Sub
End If
If TextBox6.Value = "" Then
Msg "Tri1ch ye61u no65i dung kho6ng d9u7o75c bo3 tro61ng", "Tho6ng ba1o"
TextBox6.SetFocus
Exit Sub
End If
duongdan = Range("QLCV!O41").Value
'FileDich = ThisWorkbook.Path & "\Den\"
Sheet6.Select
If Me.cb_luufile.Value = "" Or Me.cb_luufile.Value = 0 Or Me.cb_luufile.Value = Null Then
Msg "Chu7a cho5n file va8n ba3n d9i1nh ke2m!"
'Exit Sub
End If
r = 2
M = Me.txt_backupfile.Text
FileNguon = Vfile
'FileDich = m
'Msg FileDich
Do While Sheet6.Cells(r, 16) <> ""
If M = Sheet6.Cells(r, 16).Text Then
Msg "File va8n ba3n d9i1nh ke2m d9a3 to62n ta5i!"
Exit Sub
End If
r = r + 1
Loop
FileDich = ThisWorkbook.Path & M
With CreateObject("Scripting.FileSystemObject")
If .FileExists(FileNguon) Then
.CopyFile FileNguon, FileDich
Else
Msg "Kho6ng ti2m tha61y file hoa85c kho6ng the63 copy"
End If
End With
con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.Path & "\" & duongdan & "\" & duongdan & ".xls" & ";extended properties=excel 8.0"
With rs
.Open "Select * From [Data$]", con, , 2
.AddNew
![STT] = TextBox1
![MaQL] = Format(Date, "yy") & "-" & Format(Range("irow"), "00000#")
![NgayDen] = TextBox3
![loaivb] = ComboBox2
![SoKHCV] = TextBox4
![NgayThangCV] = Me.TextBox5.Value
![TrichYeuND] = Me.TextBox6.Value
![NoiBanHanh] = ComboBox3
![NguoiKy] = ComboBox4
![LuuFile] = txt_backupfile
![FileGoc] = cb_luufile
![FileType] = cb_FileType
![LuuHSS] = cb_HSVV
.Update
Msg "Ghi du74 lie65u tha2nh co6ng", "Tho6ng ba1o"
On Error Resume Next
For Each ctrl In Controls
ctrl.Value = ""
Next
End With
rs.Close: Set rs = Nothing
con.Close: Set con = Nothing
UserForm_Activate
cb_luufile.Enabled = False
TextBox3.SetFocus
End Sub
Private Sub CommandButton4_Click()
frm_BS.Show
End Sub
Private Sub CommandButton5_Click()
frm_BS.Show
End Sub
Private Sub CommandButton6_Click()
frm_BS.Show
End Sub
Private Sub Label44_Click()
End Sub
Private Sub ListBox1_Change()
Me.lb_somuc.Caption = Format(Me.ListBox1.ListCount - 1, "#,##0")
End Sub
Private Sub ListBox1_Click()
Range("Index!item").Value = Me.ListBox1.ListIndex + 1
Item = Range("index!item").Value
Range("Index!N5").Value = Me.ListBox1.Column(1)
Range("Index!N6").Value = Me.ListBox1.Column(0)
Me.Label52.BackColor = &H8000000F
Me.Label52.Caption = Range("Index!M5").Value
' CmdXem.Visible = False
cmdxemdi.Visible = False
' Me.Label24.Visible = True
'Me.Label25.Visible = True
Me.Label31.Visible = False
' Me.Label39.Visible = False
If Me.ListBox1.Column(14) <> "" Then
cmdxemdi.Visible = True
End If
If Me.ListBox1.Column(10) = Range("Index!B2") Then
Me.Label52.ForeColor = &HFF0000
Me.Label52.BackColor = &H80FF80
' CmdXem.Visible = True
Me.Label52.Caption = Range("Index!M3").Value
' Me.Label24.Visible = False
' Me.Label25.Visible = False
Me.Label31.Visible = False
'Me.Label39.Visible = False
'CmdXem.Caption = Range("Index!O1").Value
End If
If Me.ListBox1.Column(10) = Range("Index!B3") Then
Me.Label52.ForeColor = &HFF0000
Me.Label52.BackColor = vbYellow
Me.Label52.Caption = Range("Index!M4").Value
If Me.ListBox1.Column(13) = "" Then
Me.Label31.Visible = False
Else
Me.Label31.Visible = True
Me.Label31.Caption = Range("Index!M8").Value & Format(Me.ListBox1.Column(13), "dd/MM/yyyy") '& "HHHHHHHHHH" & & ": "
End If
'CmdXem.Visible = True
'CmdXem.Caption = Range("Index!O2").Value
End If
If Me.ListBox1.Column(10) = Range("Index!B4") Then
Me.Label52.ForeColor = &HFF0000
Me.Label52.BackColor = vbYellow
Me.Label52.Caption = Range("Index!M4").Value
' CmdXem.Visible = True
'CmdXem.Caption = Range("Index!O3").Value
End If
If Me.ListBox1.Column(0) <> "" Then
cmdxemden.Visible = True
CmdSua.Visible = True
End If
Me.lb_date.Caption = Format(Me.ListBox1.Column(3), "dd/MM/yyyy")
End Sub
Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim MaQL As String
Dim c As Range
If Me.TextBox2.Value <> "" Then
With Sheet2.Range("Data!C:C")
Set c = .Find(Me.TextBox2.Text, LookIn:=xlValues, LookAt:=xlPart)
If Not c Is Nothing Then
If Me.TextBox2.Value = c.Value Then
MaQL = c.Offset(0, -1)
Me.TextBox2.BackColor = &HFF&
MsgBox (" Vãn baÒn naÌy ðaÞ nhâòp rôÌi " & Chr(13) & "KiêÒm tra vãn baÒn coì maÞ QL laÌ : " & MaQL)
Me.TextBox2.SetFocus
End If
End If
End With
End If
End Sub
Private Sub TextBox2_Change()
Me.TextBox2.BackColor = &HFFFFFF
End Sub
Private Sub TextBox3_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim dDate As Date
dDate = DateSerial(Year(Date), Month(Date), Day(Date))
TextBox3.Value = Format(TextBox3.Value, "dd/mm/yyyy")
End Sub
Private Sub TextBox4_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim STT As String
Dim c As Range
If Me.TextBox4.Value <> "" Then
With Sheet6.Range("THDataDen!F:F")
Set c = .Find(Me.TextBox4.Text, LookIn:=xlValues, LookAt:=xlPart)
If Not c Is Nothing Then
If Me.TextBox4.Value = c.Value Then
STT = c.Offset(0, -5)
Me.TextBox4.BackColor = &HFF&
Msg " Va8n ba3n na2y d9a4 nha65p ro62i " & Chr(13) & "Kie63m tra va8n ba3n co1 so61 d9e61n la2 : " & STT
Me.TextBox4.SetFocus
End If
End If
End With
End If
Me.TextBox4.SetFocus
End Sub
Private Sub TextBox4_Change()
Me.TextBox4.BackColor = &HFFFFFF
End Sub
Private Sub txttenfile_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim MaQL As String
Dim s As Range
If Me.txttenfile.Value <> "" Then
With Sheet2.Range("Data!P
")
Set s = .Find(Me.txttenfile.Text, LookIn:=xlValues, LookAt:=xlPart)
If Not s Is Nothing Then
If Me.txttenfile.Value = s.Value Then
MaQL = s.Offset(0, -11)
Me.txttenfile.BackColor = &HFF&
MsgBox (" Te6n file na2y d8a to62n ta5i " & Chr(13) & "Kie63m tra la5i va7n ba3n co1 ma3 QL la2 : " & Chr(13) & MaQL)
Me.txttenfile.SetFocus
End If
End If
End With
End If
Me.txttenfile.SetFocus
End Sub
Private Sub TextBox5_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
CmdLich_Click
End Sub
Private Sub ComboBox5_Change()
Dim strDK As String
strDK = Trim(Me.ComboBox5.Value)
Range("TrackStatus").Value = strDK
'---------------------
Me.Label52.BackColor = &H8000000F
Me.Label52.Caption = Range("Index!M5").Value
'CmdXem.Visible = False
'Me.Label24.Visible = True
'Me.Label25.Visible = True
If Me.ComboBox1.Value = Range("Index!B2") Then
Me.Label52.ForeColor = &HFF0000
Me.Label52.BackColor = &H80FF80
Me.Label52.Caption = Range("Index!M3").Value
'CmdXem.Visible = True
'Me.Label24.Visible = False
'Me.Label25.Visible = False
'CmdXem.Caption = Range("Index!O1").Value
End If
If Me.ComboBox1.Value = Range("Index!B3") Then
Me.Label52.ForeColor = &HFF0000
Me.Label52.BackColor = vbYellow
Me.Label52.Caption = Range("Index!M4").Value
' CmdXem.Visible = True
' CmdXem.Caption = Range("Index!O2").Value
End If
On Error GoTo thoat
Range("AllTHDataDen").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"Crit"), CopyToRange:=Range("Ext"), Unique:=False
Me.ListBox1.RowSource = "FilterTHDataDen"
thoat: Exit Sub
End Sub
Private Sub ComboBox6_Change()
Dim strDK0 As String
strDK0 = Trim(Me.ComboBox6.Value)
Range("TrackLoai").Value = strDK0
'---------------------
On Error GoTo thoat
Range("AllTHDataDen").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"Crit"), CopyToRange:=Range("Ext"), Unique:=False
Me.ListBox1.RowSource = "FilterTHDataDen"
thoat: Exit Sub
End Sub
Private Sub ComboBox7_Change()
Dim strDK_HS As String
strDK_HS = Me.ComboBox7.Value
Range("TrackCase").Value = strDK_HS
Range("TrackLoai").Value = ""
Range("TrackSoCV").Value = ""
Range("TrackND").Value = ""
Range("TrackStatus").Value = ""
'---------------------
On Error GoTo thoat
Range("FilterTHDataDen").Select
Selection.ClearContents
Range("AllTHDataDen").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"Crit"), CopyToRange:=Range("Ext"), Unique:=False
Me.ListBox1.RowSource = "FilterTHDataDen"
thoat: Exit Sub
End Sub
Private Sub ComboBox8_Change()
Dim strDK_XL As String
strDK_XL = Trim(Me.ComboBox8.Value)
Range("Trackbpxl").Value = strDK_XL
'---------------------
On Error GoTo thoat
Range("AllTHDataDen").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"Crit"), CopyToRange:=Range("Ext"), Unique:=False
Me.ListBox1.RowSource = "FilterTHDataDen"
thoat: Exit Sub
End Sub
Private Sub TextBox7_Change()
Dim strDK2 As String
If Me.TextBox7.Value = "" Then
strDK2 = ""
Else
strDK2 = "*" & Trim(Me.TextBox7.Value)
' Range("TrackSoCV") = "*" & Trim(Me.TextBox1.Value)
End If
Range("TrackSoCV").Value = strDK2
On Error GoTo thoat
Range("AllTHDataDen").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"Crit"), CopyToRange:=Range("Ext"), Unique:=False
Me.ListBox1.RowSource = "FilterTHDataDen"
thoat: Exit Sub
End Sub
Private Sub TextBox8_Change()
Dim strDK1 As String
strDK1 = "*" & Trim(Me.TextBox8.Value) & "*"
Range("TrackND").Value = strDK1
On Error GoTo thoat
Range("AllTHDataDen").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"Crit"), CopyToRange:=Range("Ext"), Unique:=False
Me.ListBox1.RowSource = "FilterTHDataDen"
thoat: Exit Sub
End Sub
Private Sub ToggleButton1_Click()
If Me.ToggleButton1.Value = True Then
Me.ComboBox6.Visible = False
Me.ComboBox5.Visible = False
Me.ComboBox8.Visible = False
Me.Label28.Visible = False
Me.Label49.Visible = False
Me.Label50.Visible = False
Me.Label51.Visible = False
Me.Label38.Visible = False
Me.lb_file.Visible = True
Me.TextBox7.Visible = False
Me.TextBox8.Visible = False
Me.Label53.Visible = False
Me.Label30.Visible = True
Me.ComboBox7.Visible = True
Me.cb_luu.Visible = True
Me.ComboBox6.Value = ""
Me.TextBox7.Value = ""
Me.TextBox8.Value = ""
Me.ComboBox5.Value = ""
Me.ComboBox8.Value = ""
Else
Me.ComboBox5.Visible = True
Me.ComboBox6.Visible = True
Me.ComboBox8.Visible = True
Me.Label28.Visible = True
Me.Label38.Visible = True
Me.Label49.Visible = True
Me.Label50.Visible = True
Me.Label51.Visible = True
Me.Label53.Visible = True
Me.TextBox7.Visible = True
Me.TextBox8.Visible = True
Me.Label30.Visible = False
Me.ComboBox7.Visible = False
Me.ComboBox7.Value = ""
Me.cb_luu.Value = ""
Me.cb_luu.Visible = False
Me.lb_file.Visible = False
Range("TrackSoCV") = ""
Range("TrackND") = ""
Range("TrackStatus") = ""
Range("TrackLoai") = ""
Range("TrackCase") = ""
Range("Trackbpxl") = ""
Range("TrackNoiBanHanh") = ""
Range("AllTHDataDen").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"Crit"), CopyToRange:=Range("Ext"), Unique:=False
Me.ListBox1.RowSource = "FilterTHDataDen"
Me.ListBox1.ListIndex = Me.ListBox1.ListCount - 2
Me.ListBox1.SetFocus
End If
End Sub
Private Sub UserForm_Activate()
' MoKetNoi
NHAP_DEN
FormNhap.Caption = "DANG KY CONG VAN DEN"
' Me.Caption = "NHAP CONG VAN DEN " & " NAM " & Left(ActiveWorkbook.name, Len(ActiveWorkbook.name) - 4)
SendKeys "%{ }X"
'Nha^.n ðo^. ro^.ng và ðo^. cao ban ða^`u cu?a form
OldWidth = Width
OldHeight = Height
'Nha^.n handle/hWnd cu?a form
If Val(Application.Version) < 9 Then
hwnd = FindWindow("ThunderXFrame", Caption) 'XL97
Else
hwnd = FindWindow("ThunderDFrame", Caption) 'XL2000
End If
'hWnd ðýo+.c dùng ðe^? thie^'t la^.p thuo^.c tính co gia~n form, thêm nút Min, Max
PrevStyle = GetWindowLong(hwnd, GWL_STYLE)
SetWindowLong hwnd, GWL_STYLE, PrevStyle _
Or WS_SIZEBOX _
Or WS_MINIMIZEBOX _
Or WS_MAXIMIZEBOX
' MoKetNoi
' Set rs = CreateObject("ADODB.Recordset")
' rs.Open "SELECT STT, MaQL, MaVT, NgayDen, LoaiVB, SoKHCV, NgayThangCV, TrichYeuND, NoiBanHanh, NguoiKy, TrangThai, HinhThucXuLy, BoPhanXuLy, HanXuLy, KetQuaXuLy, LuuFile, LuuHSS FROM [Data$] WHERE STT IS NOT NULL", cn
' If Not (rs.BOF And rs.EOF) Then
' Me.ListBox1.ColumnCount = rs.Fields.Count
' Me.ListBox1.Column = rs.GetRows()
' End If
' rs.Close: Set rs = Nothing
lb_nam.Caption = Sheet3.[O41].Value
LB_NAMCV.Caption = Sheet3.[O41].Value & Chr(13) & Chr(13) & "Weekday: " & Weekday(Now) & Chr(13) & Format(Date, "dd/mm/yyyy")
Range("AllTHDataDen").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"Crit"), CopyToRange:=Range("Ext"), Unique:=False
Me.ListBox1.RowSource = "FilterTHDataDen"
Me.ListBox1.ListIndex = Me.ListBox1.ListCount - 2
lb_somuc.Caption = Format(ListBox1.ListCount, "#,##0")
Me.TextBox1.Value = Format(ListBox1.ListCount, "0#")
lb_somuc.Caption = Format(ListBox1.ListCount, "#,##0") - 1
If Format(Now, "yyyy") <> duongdan Then
Me.TextBox3.Value = ""
Else
Me.TextBox3.Value = Format(Date, "dd/MM/yyyy")
End If
Me.ListBox1.SetFocus
TextBox2.SetFocus
End Sub
Private Sub UserForm_Initialize()
check = "FormNhap"
duongdan = Range("QLCV!O41").Value
NHAP_DEN
FormNhap.Caption = "FORM NHAP DU LIEU VAN BAN MOI NHAN"
Me.Label12.Caption = Range("Index!M7").Text & Format(Date, "yy") & "-" & Format(Range("irow"), "00000#")
' lb_somuc.Caption = Format(ListBox1.ListCount, "#,##0") - 1
If Format(Now, "yyyy") <> duongdan Then
Me.TextBox3.Value = ""
Else
Me.TextBox3.Value = Format(Date, "dd/MM/yyyy")
End If
Me.ComboBox7.Visible = False
Me.Label30.Visible = False
Me.lb_file.Visible = False
Sheets("THDataDen").Select
Range("THDataDen").Select
Range("AllTHDataDen").Select
' Me.ListBox1.RowSource = "THDataDen"
Sheets("LOCDEN").Select
Range("FilterTHDataDen").Select
End Sub
Private Sub UserForm_Resize()
zoom = Round(Width / OldWidth * 100, 0)
End Sub
Private Sub TextBox5_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim dDate As Date
dDate = DateSerial(Year(Date), Month(Date), Day(Date))
TextBox5.Value = Format(TextBox5.Value, "dd/mm/yyyy")
'dDate = TextBox5.Value
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then Cancel = True
Sheet9.[L3].Clear
End Sub
Sub MoKetNoi()
duongdan = Sheet3.[O41].Value
Set cn = CreateObject("ADODB.Connection")
If cn.State = 1 Then cn.Close
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\" & duongdan & "\" & duongdan & ".xls" & ";Extended Properties=""Excel 8.0;HDR=Yes;"";"
End Sub
.
