From ThichExcel: Xin diễn đàn cho tôi hỏi 2 vấn đề như sau -- Vấn đề 1: Tôi lập 1 ListBox và Add nội dung vào trong đó, tuy nhiên có 1 số nội dung khá dài làm cho khi xuất hiện trên ListBox nó bị mất các thông tin phía cuối. Nếu tôi mà kéo dài kích thước Listbox ra thì trông rất cồng kềnh và có thể vượt quá cả kích thước màn hình. Tôi xin hỏi diễn đàn có cách nào xử lý vấn đề tôi vướng mắc không ? Vấn đề 2 : Có phải Lish Box không sử dụng được nút giữa của chuột để rê lên xuống các hàng dữ liệu không? Nếu sử dụng được xin diễn đàn chỉ giúp? Xin cảm ơn diễn đàn.
From ThichExcel: Xin cám ơn cậu Cường đã đọc thắc mắc của tôi.Nhưng tôi không hiểu là tại sao 1 vấn đề của ListBox (Đây là 1 đối tượng của lập trình VBA) lại bị coi là sai chủ đề. Vậy theo cậu thì vấn đề về chuyển dữ liệu từ Form vào bảng tính của bạn trước chắc cũng sai chủ đề mà sao vẫn nằm trong chuyên mục này?(Form chỉ là nơi chứa các đối tượng như ListBox, ComBox,...)Nếu coi lập trình EXCEL chỉ đơn thuần là viết các Code mà bỏ qua các đối tượng cơ bản thì có lẽ ta đã bỏ đi 2/3 khả năng của VBA EXCEL. Thực ra bạn hỏi câu 1 cũng có liên quan đến VBA đấy chứ, tức là sử dụng Item trong ListBox. Nếu quá nhiều Item thì đương nhiên là khi bạn thả xuống thì đầy màn hình là phải. Đành phải chấp nhận thôi hoặc chuyển sang hướng quản lý dữ liệu kiểu khác. Ví dụ có thể chia thành các nhóm nhỏ. Còn câu 2 thì đúng là ngoài khả năng của Excel rồi. Mà sao bạn không sử dụng chuột trái mà lại sử dụng chuột giữa chứ?
Trong ListBox, không ai để Item quá dài như bạn. Nên rút ngắn đoạn đó và có thể dùng hàm bổ trợ như Index để thể hiện đầy đủ nội dung trên bảng tính.
Mọi thứ có thể giải quyết được. Kể cả là vấn đề Listbox. Nhiều khi bạn có thể không thể list hết các text trong item ra listbox vì dù sao dữ liệu dài hay ngắn là dynamic mà màn hình thì có giới hạn của nó. Tuy nhiên bạn có thể lập trình để khi di chuột đến đó thì item đó expend độ rộng ra (để hình dung rõ, bạn có thể xem chương trình Lạc việt từ điển). Đơn giản hơn, bạn có thể show tooltip để hiển thị nội dung Item đó khi di chuột lên. Nhưng mà, theo mình con ti tỷ cách để thực hiện 1 vấn đề. Bạn có thể nghĩ cách "out of box" chữ ko nên quanh quẩn với listbox. Ví dụ: Bạn có thể dùng listview hoặc 1 số loại grid khác thay thế. Thực ra, bản chất của Listbox chính là 1 window. Nếu bạn giỏi về windows programing thì ko những bạn có thể làm cho listbox xuất hiện horizotal scrollbar mà còn hiện cả title bar, minimized, maximixed, closed buttons y như 1 window (form) vậy. Nhưng đúng là cái này thì ngoài khả năng lập trình của rất nhiều người, và của cả cái box lập trình Excel như Cường nói.
. . . . . . . . . . . . . . . . . . . . .
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 A cho em xin file này với ? A xóa trắng đi để tránh lộ thông tin ! Em rất cần file này. A gửi cho em qua mail này nhé ? A cho em xin file này với ? A xóa trắng đi để tránh lộ thông tin ạ ! Em rất cần file này. A gửi cho em qua mail nhé:
Bài đã được tự động gộp: 13/8/19 A cho em xin file này với ? A xóa trắng đi để tránh lộ thông tin ạ ! Em rất cần file này. A gửi cho em qua mail nhé: |