Giúp đỡ code VBA cho userform (1 người xem)

[JSin]

Lời đầu tiên em xin gửi lời chào tới toàn thể anh chị em ạ.
Tiếp xúc với VBA cũng được hơn 1 tuần, với kiến thức học hỏi tìm hiểu, em cũng tự viết code tạo user form cho công việc. Nay có kha khá vướng mắc, mong anh chị em giúp đỡ, nếu có gì chưa đúng với nội quy diễn đàn mong cả nhà lượng thứ.
File excel e có gửi kèm, và cấn đề của e như sau:
1.Tại code cho nút thêm nhóm:
_ phần sắp xếp sheets theo bảng chữ cái tiếng việt khiến e bị mắc ( ví dụ trong file excel thì chữ "Bình" lại xếp trước chữ "Bắc")
2. Tại combobox Tennhom:
_ E định nhập dữ liệu cho cmbTennhom là tại sheets("Data") vùng từ ô A2 tới ô cuối cùng có dữ liệu của cột: Nghĩa là khi Nhóm mới được thêm vào thì dữ liệu ở cmbTennhom cũng được update mà thay đổi ạ.
Hiện tại em đang làm và vướng mắc tới đó. Mong các bác giúp đỡ em, em xin cảm ơn

 

[giaiphap]

Thứ nhất việc sắp xếp tên sheet theo thứ tự chữ cái tiếng việt có dấu hơi bị khó, hơi quá sức của tôi.
Thứ hai bạn thêm code này vào trong Form

Private Sub UserForm_Initialize()
     Me.cmbTennhom.RowSource = "Data!A2:A" & Sheets("Data").Range("A65000").End(xlUp).Row
End Sub

Sau đó bạn thêm dòng code màu đỏ vào cuối nút lệnh Thêm, đoạn code của nút lệnh Thêm như sau.

Private Sub cmdThem_Click()
    Dim ws As Worksheet, tenmoi As String
    If txtSTT.Text = "00" Or txtSTT.Text = "0" Then
        tenmoi = txtTenmoi.Text + "_" + txtDaidien.Text
    Else
        tenmoi = txtTenmoi.Text + "." + txtSTT.Text + "_" + txtDaidien.Text
    End If
    'bat loi su kien bo trong
    If txtTenmoi.Value = "" Then
        txtTenmoi.BackColor = vbRed
        lblTenmoi.ForeColor = vbRed
        txtTenmoi.SetFocus
        Exit Sub
    End If
    If txtDaidien.Value = "" Then
        txtDaidien.BackColor = vbRed
        lblDaidien.ForeColor = vbRed
        txtDaidien.SetFocus
        Exit Sub
    End If
    If txtSTT.Value = "" Then
        txtSTT.BackColor = vbRed
        txtSTT.SetFocus
        Exit Sub
    End If
    On Error Resume Next
    Set ws = Sheets(tenmoi)
    On Error GoTo 0
    'kiem tra ten sheet da co chua
    If ws Is Nothing Then
        'tao sheet moi
        Set ws = ActiveWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count))
        'tao sheet mang ten nhom moi
        ActiveSheet.Name = tenmoi
         
            With ws
            .Range("B2").Value = "H" & ChrW(7885) & " v" & ChrW(224) & " T" & ChrW(234) & "n " & ChrW(273) & ChrW(7879) & "m"
            .Range("C2").Value = "T" & ChrW(234) & "n"
            .Range("D2").Value = "C" & ChrW(7845) & "p l" & ChrW(7899) & "p hi" & ChrW(7879) & "n t" & ChrW(7841) & "i"
            .Range("E2").Value = "N" & ChrW(259) & "m sinh"
            .Range("F2").Value = "Gi" & ChrW(7899) & "i t" & ChrW(237) & "nh"
            .Range("G2").Value = "SDT"
            .Range("H2").Value = "Email"
            .Range("I2").Value = "T" & ChrW(236) & "nh h" & ChrW(236) & "nh s" & ChrW(7913) & "c kh" & ChrW(7887) & "e"
            .Range("J2").Value = "Ghi ch" & ChrW$(250)
            .Range("a2:j2").Font.Bold = True
            .Range("a2:j2").EntireColumn.Autofit
            End With
            'sapxep thu tu sheet
            For i = 2 To Application.Sheets.Count
                For j = 2 To Application.Sheets.Count - 1
                    If UCase$(Application.Sheets(j).Name) > UCase$(Application.Sheets(j + 1).Name) Then
                        Sheets(j).Move After:=Sheets(j + 1)
                    End If
                Next
            Next
            'xoa sheet se xoa cac o thua, chon o cuoi cung co du lieu
            Dim row_i As Long
            row_i = ActiveSheet.UsedRange.Rows.Count
            Range(Cells(Application.Sheets.Count + 1, 1), Cells(row_i, 1)).Value = ""
       'tao muc luc lien ket
        Dim wsSheet As Worksheet
        Dim Counter As Long
        ActiveWorkbook.Sheets("Data").Select
        Counter = 1
        For Each wsSheet In Worksheets
            If wsSheet.Name <> Sheets("Data").Name Then
            'Them nut Quay ve Sheet Muc luc tai moi Sheet
            With wsSheet
                .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", SubAddress:="Data", TextToDisplay:="Quay v" & ChrW$(7873) & " Data"
                .Range("A2").Value = "STT"
                '.Visible = False
            End With
            'Tao lien ket
            wsSheet.Hyperlinks.Add Anchor:=ActiveWorkbook.Sheets("Data").Cells(Counter + 1, 1), _
            Address:="", _
            SubAddress:="'" & wsSheet.Name & "'" & "!B1", _
            ScreenTip:=wsSheet.Name, _
            TextToDisplay:=wsSheet.Name
            Counter = Counter + 1
            End If
        Next wsSheet
        Set xlSheet = Nothing
        'tu dong can chinh cot a
        With Sheets("Data")
            .Columns("A").EntireColumn.Autofit
        End With
        'xoa du lieu nhap
        txtTenmoi.BackColor = vbWhite
        lblTenmoi.ForeColor = vbBlack
        txtDaidien.BackColor = vbWhite
        lblDaidien.ForeColor = vbBlack
        txtTenmoi.Value = ""
        txtDaidien.Value = ""
        txtSTT.Value = ""


    Else:
        'neu ten nhom da co, xoa du lieu nhap
        txtTenmoi.BackColor = vbWhite
        lblTenmoi.ForeColor = vbBlack
        txtDaidien.BackColor = vbWhite
        lblDaidien.ForeColor = vbBlack
        txtTenmoi.Value = ""
        txtDaidien.Value = ""
        txtSTT.Value = ""
        MsgBox ("T" & ChrW$(234) & "n nh" & ChrW$(243) & "m " & ChrW$(273) & ChrW$(227) & " c" & ChrW$(243))
   End If
[B][COLOR=#ff0000] Me.cmbTennhom.RowSource = "Data!A2:A" & Sheets("Data").Range("A65000").End(xlUp).Row[/COLOR][/B]
End Sub

 

[chucuoi92]

Lời đầu tiên em xin gửi lời chào tới toàn thể anh chị em ạ.
Tiếp xúc với VBA cũng được hơn 1 tuần, với kiến thức học hỏi tìm hiểu, em cũng tự viết code tạo user form cho công việc. Nay có kha khá vướng mắc, mong anh chị em giúp đỡ, nếu có gì chưa đúng với nội quy diễn đàn mong cả nhà lượng thứ.
File excel e có gửi kèm, và cấn đề của e như sau:
1.Tại code cho nút thêm nhóm:
_ phần sắp xếp sheets theo bảng chữ cái tiếng việt khiến e bị mắc ( ví dụ trong file excel thì chữ "Bình" lại xếp trước chữ "Bắc")
2. Tại combobox Tennhom:
_ E định nhập dữ liệu cho cmbTennhom là tại sheets("Data") vùng từ ô A2 tới ô cuối cùng có dữ liệu của cột: Nghĩa là khi Nhóm mới được thêm vào thì dữ liệu ở cmbTennhom cũng được update mà thay đổi ạ.
Hiện tại em đang làm và vướng mắc tới đó. Mong các bác giúp đỡ em, em xin cảm ơn

Không biết máy của bạn có dùng được cái này không:
Dưới đây là đoạn code xếp lại vị trí các sheets trong file của bạn, nếu bạn thử thấy chạy tốt thì có thể ứng dụng vào bài của bạn.

Sub sort_vitri_sheet()
Dim d As Object, i
Set d = CreateObject("system.collections.sortedlist")
For i = 2 To Worksheets.Count
    d.Add Sheets(i).Name, ""
Next
For i = 2 To Worksheets.Count
    Sheets(d.getkey(i - 2)).Move Before:=Sheets(d.IndexOfKey(d.getkey(i - 2)) + 2)
Next
End Sub

 

[JSin]

Em chân thành cảm ơn hai bác đã giúp đỡ em. Cả hai đoạn code e thêm vào đều thực hiện thật trơn tru
Các bác giúp đỡ em thêm chút là ở cmbTennhom em không muốn cho nhập dữ liệu khi load form mà chỉ cho chọn danh sách sổ xuống thôi thì viết thế nào ạ. ( nghĩa là không thể đánh ký tự vào cmbTennhom)

 

[chucuoi92]

Em chân thành cảm ơn hai bác đã giúp đỡ em. Cả hai đoạn code e thêm vào đều thực hiện thật trơn tru
Các bác giúp đỡ em thêm chút là ở cmbTennhom em không muốn cho nhập dữ liệu khi load form mà chỉ cho chọn danh sách sổ xuống thôi thì viết thế nào ạ. ( nghĩa là không thể đánh ký tự vào cmbTennhom)

bạn có thể làm theo điều kiện MouseMove
code ví dụ:

Private Sub cmbTennhom_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If X >= 81 And Y >= 0 Then
    Me.cmbTennhom.Locked = False
   Else
   Me.cmbTennhom.Locked = True
End If
End Sub

 

[JSin]

Xin chân thành cảm ơn hai bác đã hỗ trợ em, mong rằng trong quá trình làm việc với VBA em có gì vướng mắc mong các bác giúp đỡ em thêm. Em xin cảm ơn!