Add-Ins Tạo Menu RibbonTiếng Việt Có Dấu Cho Office

Liên hệ QC
thaipv đã viết:
Hix, bạn này vui tính nhỉ.
Nhấp chuột vào đây để mở rộng...

Mình đang nghĩ tại sao không nghĩ cách viết code chạy cái rẹt nó thay thế file Custom UI.xml ... Chèm mã XML trên Sheet Vào nhỉ vì File này có thể Edit bằng Notepad của windows được ko lỗi Font vì Xài Hàm RibbonTV

sẻ hay đấy...
 
kieu manh đã viết:
Mình đang nghĩ tại sao không nghĩ cách viết code chạy cái rẹt nó thay thế file Custom UI.xml nhỉ vì File này có thể Edit bằng Notepad của windows được ko lỗi Font vì Xài Hàm RibbonTV

sẻ hay đấy...
Nhấp chuột vào đây để mở rộng...

Bạn nghiên cứu tiếp đi, vì còn nhiều vấn đề nữa : Thêm hình tự tạo, các control loại khác nữa (slpitButton, Menu, tglButton, ....).

Hiện mình làm biếng quá nên chia sẻ mã nguồn lên đây để các bạn phát triển tiếp
 
Quả thật rất nhiểu bổ ích, cách của bạn thaipv tôi thấy cũng hay đấy.
 
thaipv đã viết:
Bạn nghiên cứu tiếp đi, vì còn nhiều vấn đề nữa : Thêm hình tự tạo, các control loại khác nữa (slpitButton, Menu, tglButton, ....).

Hiện mình làm biếng quá nên chia sẻ mã nguồn lên đây để các bạn phát triển tiếp
Nhấp chuột vào đây để mở rộng...
Xem ra phải nhờ Bạn hướng dẫn Chi Tiết cho File Ribbon Creator Sheet Main chi tiết Một tí ....

xem quy luật sắp xếp nó chi Tiết thế nào ...Mình thử thiết kế nhiều thấy lỗi...

Hay ta viết code trên sự Kiện Change cho Nó check lỗi ta ...giống như Custom UI Editor.exe ý ....
 
kieu manh đã viết:
Xem ra phải nhờ Bạn hướng dẫn Chi Tiết cho File Ribbon Creator Sheet Main chi tiết Một tí ....

xem quy luật sắp xếp nó chi Tiết thế nào ...Mình thử thiết kế nhiều thấy lỗi...
Nhấp chuột vào đây để mở rộng...
Cách sử dụng Ribbon Creator : (Thiết kế Ribbon trên sheet MAIN để làm)
Cột A (ID) - Mã ID của control : Viết liền, không dấu, không được trùng.
Cột B (Level) – Các bạn điền 1 (nếu là Tab), 2 (nếu là Group) và 3 (nếu là Button). Cái này lưu ý không được bỏ Group (tức là từ Tab xuống Button luôn là sai)
Cột C (Size) – Kích thước của button : large, normal
Cột D (Label) – Tên control : Áp dụng đối với tất cả (Tab, Group, Button)
Cột E (ScreenTip) – Ghi chú : Áp dụng cho các button
Cột F (SuperTip) – Ghi chú thêm : Áp dụng cho các button
Cột G (KeyTip) – Phím tắt : Áp dụng cho Tab và Button
Cột H (ImageMso) – Biểu tượng của Group (tùy chọn) và Button
Cột I (Test) – Kiểm tra sự trùng lặp của ID control (Không nhập cột này, fill công thức để dùng)

Khác với VBA, các từ khóa trong tập XML này phải chính xác, có phân biệt chữ hoa, chữ thường. Các ID control không được trùng (kiểm tra bằng cột I)

kieu manh đã viết:
Hay ta viết code trên sự Kiện Change cho Nó check lỗi ta ...giống như Custom UI Editor.exe ý ....
Nhấp chuột vào đây để mở rộng...
Cái này mình chưa nghĩ tới.
 
thaipv đã viết:
Cách sử dụng Ribbon Creator : (Thiết kế Ribbon trên sheet MAIN để làm)
Cột A (ID) - Mã ID của control : Viết liền, không dấu, không được trùng.
Cột B (Level) – Các bạn điền 1 (nếu là Tab), 2 (nếu là Group) và 3 (nếu là Button). Cái này lưu ý không được bỏ Group (tức là từ Tab xuống Button luôn là sai)
Cột C (Size) – Kích thước của button : large, normal
Cột D (Label) – Tên control : Áp dụng đối với tất cả (Tab, Group, Button)
Cột E (ScreenTip) – Ghi chú : Áp dụng cho các button
Cột F (SuperTip) – Ghi chú thêm : Áp dụng cho các button
Cột G (KeyTip) – Phím tắt : Áp dụng cho Tab và Button
Cột H (ImageMso) – Biểu tượng của Group (tùy chọn) và Button
Cột I (Test) – Kiểm tra sự trùng lặp của ID control (Không nhập cột này, fill công thức để dùng)

Khác với VBA, các từ khóa trong tập XML này phải chính xác, có phân biệt chữ hoa, chữ thường. Các ID control không được trùng (kiểm tra bằng cột I)


Cái này mình chưa nghĩ tới.
Nhấp chuột vào đây để mở rộng...
Cảm Ơn Bạn

Để phát triển thêm mã Nguồn của Bạn ...

Mình mới Tạm viết sơ bộ cho Sheet Main Sự Kiện Change Như Sau Nó sẻ giúp phần nào kiểm Soát lỗi và tự

động tạo Mã ID, Size và Key Tip ... Riêng Key Tip Nếu không thích thì gõ trực tiếp vào đó ...

Để Xem tình hình Sao ... Mình sẻ viết Một Code Kiểm tra Lỗi trước Khi Chuyển Qua Mã Custom UI

Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ExitSub
Dim MyTab As String: MyTab = "MyTab" & GetRandName
Application.EnableEvents = False
    If Not Intersect([B2:B300], Target) Is Nothing Then
        If Target.Value = 1 Then
            With Target
                .Offset(, -1).Value = MyTab
                .Offset(, -1).Interior.ColorIndex = 6
                .Offset(, 1).Value = Empty
                .Offset(, 2).Interior.ColorIndex = 6
                .Offset(, 3).Value = Empty
                .Offset(, 4).Value = Empty
            End With
        ElseIf Target.Value = 2 Then
            With Target
                .Offset(, -1).Interior.ColorIndex = 8
                .Offset(, 1).Value = Empty
                .Offset(, 2).Interior.ColorIndex = 8
                .Offset(, 3).Value = Empty
                .Offset(, 4).Value = Empty
                .Offset(, 5).Value = Empty
            End With
        ElseIf Target.Value = 3 Then
            With Target
                .Offset(, -1).Interior.ColorIndex = xlNone
                .Offset(, 1).Value = "large"
                .Offset(, 2).Interior.ColorIndex = xlNone
                .Offset(, 5).Value = GetRandName
            End With
        Else
            Target.Value = Empty
            Target.Select
            MsgBox "Chi Duoc Nhap 1, 2 Hay 3", 64, "Thông Báo"
        End If
    End If
ExitSub:
Application.EnableEvents = True
End Sub


Private Function GetRandName() As String
    ''//Tao so Ngau nhien ... Copy Form GPE
    GetRandName = Mid(CreateObject("Scripting.FileSystemObject").GetTempName, 4, 2)
End Function
 
Lần chỉnh sửa cuối:
Cuối Cùng Mạnh cũng xử lý xong Khi tạo Menu Ribbon ta không nhớ quy luật khai báo ban đầu...

Sẻ lỗi không tạo được ....Chép code sau vào Sheet Main ..

Chỉ Việc Gõ 1,2,3 vào [B2:B] thì nó sẻ báo lỗi cho Biết ...đơn giản phải ko nào .....

Mạnh Úp tặng cho Bạn nào cần kết hợp với Code của thaipv ....Thì Tạo Menu Ribbon Tiếng Việt chở nên đơn giản

không cần thiết phải nhớ khai báo mằn cái chi cho Nhức đầu ....Code Nó Nhớ ....

Chỉ cần Sự kiện Change cũng xử lý OK...

Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ExitSub ''Coded By Kieu Manh - GPE
Dim MyTab As String: MyTab = "Book" & GetRandName               ''//Tao Tab Ngau nhien ko trung
Dim MyID As String: MyID = "WL" & MyCount                       ''//Ten ID cac Tab con Cong them 1
Application.EnableEvents = False
    If Not Intersect([B2:B300], Target) Is Nothing Then
        If Target.Offset(, 6).Value = Empty Then
            Target.Offset(, 6).Value = "OldMenu"                ''//Neu Bo trong ta cho Mat cuoi Vao Do cho ko Loi Code
        End If
        If Target.Value = 1 Then                                ''//Ap dung cho Tao 1 Tab Moi tren Menu Ribbon
            With Target
                If .Offset(, 2) <> Empty Then
                    If Target.Value = Target.Offset(-1) Then
                        Target.Value = Empty: Target.Select         ''//Xu ly loi khi tao moi 2 Tab lien Tiep
                        MsgBox "Error ... Create Tab Ribbon", 64, "Thông Báo"
                        GoTo ExitSub:
                    End If
                    .Offset(, -1).Value = MyTab                     ''//Ten Tab moi tren Menu Ribbon
                    .Offset(, -1).Interior.ColorIndex = 6           ''//To Mau cho de nhin va Kiem soat loi
                    .Offset(, 1).Value = Empty
                    .Offset(, 2).Interior.ColorIndex = 6            ''//To Mau cho de nhin va Kiem soat loi
                    .Offset(, 3).Value = Empty
                    .Offset(, 4).Value = Empty
                    .Offset(, 5).Value = GetRandName                ''//Key Tip Cua MyTab bat buoc phai co ...Tao So ngau nhien
                    .Offset(1).Value = 2: Target.Offset(1).Select   ''//Goi Y Tao Tab Theo Code...Neu khong Theo trinh tu La Error
                Else
                    Target.Value = Empty: Target.Offset(, 2).Select
                    MsgBox "Ban Bo Trong Ten - Label ...Error", 64, "Thông Báo"
                End If
            End With
        ElseIf Target.Value = 2 Then                                ''//Ap dung cho Tao Nhieu Tab trong 1 Tab [Group = Nhieu Tab]
            With Target
                If .Offset(, 2) <> Empty Then
                    If Target.Value = Target.Offset(-1) Then
                        Target.Value = Empty: Target.Select         ''//Xu ly loi khi tao moi 2 Tab [Group] lien Tiep
                        MsgBox "Error ... Create Tab Ribbon", 64, "Thông Báo"
                        GoTo ExitSub:
                    End If
                    .Offset(, -1).Interior.ColorIndex = 8           ''//To Mau cho de nhin va Kiem soat loi
                    .Offset(, -1).Value = MyID
                    .Offset(, 1).Value = Empty
                    .Offset(, 2).Interior.ColorIndex = 8            ''//To Mau cho de nhin va Kiem soat loi
                    .Offset(, 3).Value = Empty
                    .Offset(, 4).Value = Empty
                    .Offset(, 5).Value = Empty
                    .Offset(1).Value = 3: Target.Offset(1).Select   ''//Goi Y Tao Tab Theo Code ...Neu khong Theo trinh tu La Error
            Else
                Target.Value = Empty: Target.Offset(, 2).Select
                MsgBox "Ban Bo Trong Ten - Label ...Error", 64, "Thông Báo"
            End If
            End With
        ElseIf Target.Value = 3 Then                            ''//Ap dung cho Tao 1 Button rieng le
            With Target
                If .Offset(, 2) <> Empty Then                   ''//Xu ly loi khi bo trong Lable - Ten
                    If .Offset(, 3) <> Empty Then               ''//Xu ly loi khi bo trong Ghi Chu - Ben duoi Ten
                        If .Offset(, 4) <> Empty Then           ''//Xu ly loi khi bo trong SuperTip - Comment
                            .Offset(, -1).Interior.ColorIndex = xlNone      ''//Xoa To Mau
                            .Offset(, -1).Value = MyID
                            .Offset(, 1).Value = "large"                    ''//Size large = To; normal = Nho
                            .Offset(, 2).Interior.ColorIndex = xlNone
                            .Offset(, 5).Value = GetRandName                ''//Tao Key Tip ngau nhien
                        Else
                            Target.Value = Empty: Target.Offset(, 4).Select
                            MsgBox "Ban Bo Trong Screen Tip ...Error", 64, "Thông Báo"
                        End If
                    Else
                        Target.Value = Empty: Target.Offset(, 3).Select
                        MsgBox "Ban Bo Trong Screen Tip ...Error", 64, "Thông Báo"
                    End If
                Else
                    Target.Value = Empty: Target.Offset(, 2).Select
                    MsgBox "Ban Bo Trong Ten - Label ...Error", 64, "Thông Báo"
                End If
            End With
        Else
            Target.Value = Empty: Target.Select                 ''//Xoa du lieu Sai
            MsgBox "Chi Duoc Nhap 1, 2 Hoac 3", 64, "Thông Báo" ''//Thong bao du lieu Sai
        End If
    End If
ExitSub:                                                        ''//Xu ly Loi ...
Range("A2").Value = "WALL"                                      ''//Ten Tab moi dau Tien ...
Application.EnableEvents = True
End Sub


''// Den Tang Dan luu trong Registry
Private Function MyCount() As Long
    Dim lCounts As Long
    Application.Volatile
    lCounts = GetSetting("MyCount", "Settings", "Counts", 0) + 1
    SaveSetting "MyCount", "Settings", "Counts", lCounts
    MyCount = lCounts
    If lCounts > 1000 Then DeleteSetting "MyCount", "Settings", "Counts"
End Function


''// Tao So Ngau Nhien
Private Function GetRandName() As String
    ''//Tao so Ngau Nhien ...Copy Form - GPE
    GetRandName = Mid(CreateObject("Scripting.FileSystemObject").GetTempName, 4, 2)
End Function
 
Lần chỉnh sửa cuối:
Tôi thấy cái này hay quá, bác Kieumanh nghiên cứu tiếp thêm các nút lệnh khác như checkbox, textbox, dropdown, dropMenu...
 
giaiphap đã viết:
Tôi thấy cái này hay quá, bác Kieumanh nghiên cứu tiếp thêm các nút lệnh khác như checkbox, textbox, dropdown, dropMenu...
Nhấp chuột vào đây để mở rộng...
Từ từ ta nghiên cứu từng cái 1 ...hoàn thiện nó trong 1,2,3 thao tác ....là xong

Giờ giaiphap thử làm xem bằng cách gì ta không cần giải nén file customUI14.xml ...

Mà dùng code tao ra nó xong Open File Excel lên kéo thả vào là xong ....--=0....

làm nhiều thao tác biếng quá...giaiphap thử cho mạnh coi một tí nha
 
kieu manh đã viết:
Từ từ ta nghiên cứu từng cái 1 ...hoàn thiện nó trong 1,2,3 thao tác ....là xong

Giờ giaiphap thử làm xem bằng cách gì ta không cần giải nén file customUI14.xml ...

Mà dùng code tao ra nó xong Open File Excel lên kéo thả vào là xong ....--=0....

làm nhiều thao tác biếng quá...giaiphap thử cho mạnh coi một tí nha
Nhấp chuột vào đây để mở rộng...
Mình tìm kiếm nên các code có thể còn vụng bạn xem và góp ý kiến.
1. Mở file YourApp.xlsm, lưu lại thành file zip.
2. giải nén file zip này ra.
3. Xóa 2 file XML ra, và xóa luôn file nén.
4. Tạo lại 2 file XML.
5. Nén thư mục vừa giải nén ở bước 2.
6. Đổi tên file nén thành file xlsm.
7. Xóa thư mục đã giải nén ở bước 2 (nhưng sao khi chạy nó lúc xóa được lúc không, chưa hiểu nguyên nhân).
8. Mở file xlsm vừa tạo ra xem kết quả.
Cách làm của mình chủ yếu là tìm kiếm trên Internet nên code có lẽ hơi rườm rạ, bác kieumanh xem và sửa lại theo ý thích, à mà code kiểm tra của bác kieumanh ở sheets Main chưa chính xác, nếu để code chạy tự động thì khi tạo ra file xlsm bị lỗi không xem được ribbon(Đã test và quyết định bỏ code chạy ngon cành đào).
 

File đính kèm

giaiphap đã viết:
Mình tìm kiếm nên các code có thể còn vụng bạn xem và góp ý kiến.
1. Mở file YourApp.xlsm, lưu lại thành file zip.
2. giải nén file zip này ra.
3. Xóa 2 file XML ra, và xóa luôn file nén.
4. Tạo lại 2 file XML.
5. Nén thư mục vừa giải nén ở bước 2.
6. Đổi tên file nén thành file xlsm.
7. Xóa thư mục đã giải nén ở bước 2 (nhưng sao khi chạy nó lúc xóa được lúc không, chưa hiểu nguyên nhân).
8. Mở file xlsm vừa tạo ra xem kết quả.
Cách làm của mình chủ yếu là tìm kiếm trên Internet nên code có lẽ hơi rườm rạ, bác kieumanh xem và sửa lại theo ý thích, à mà code kiểm tra của bác kieumanh ở sheets Main chưa chính xác, nếu để code chạy tự động thì khi tạo ra file xlsm bị lỗi không xem được ribbon(Đã test và quyết định bỏ code chạy ngon cành đào).
Nhấp chuột vào đây để mở rộng...
để mình Nghiên cứu xem mình viết code này giống Bạn
Mã: 
Public Sub CreateStrXML()
    Dim UI As String, XML As Worksheet, i As Long
    UI = ThisWorkbook.Path & "\customUI14.xml"
    Set XML = ThisWorkbook.Worksheets("XML")
        With CreateObject("Scripting.FileSystemObject")
            With .CreateTextFile(UI, True, True)
                For i = 1 To 1000
                    .WriteLine XML.Cells(i, 1)
                Next
                .Close
            End With
        End With
    Set XML = Nothing
End Sub

Hướng Mình sẻ làm như sau nhưng còn lỗi
1/ xuất File customUI14.xml từ Excel ra ....xong sử dụng Code đổi File YourApp.xlsm Sang YourApp.zip

Xong chuyển File customUI14.xml ...vào File *.zip đúng vị trí của nó ....xong đổi đuôi

File YourApp.zip sang YourApp.xlsm

Trong 1 nút nhấm ...nhưng đang lỗi ....Bạn tham khảo Loạt Bài của Anh Nduvà doveandrose

Link Sau:
http://www.giaiphapexcel.com/forum/...hững-thuật-toán-nén-và-giải-nén-file&p=675613

Nếu 2 ngài này chịu ra tay cho mình học với thì vài dòng code là xong

Code hay và nhân tài GPE kiệt xuất Hông kiếm ...Tìm xa xôi chi cho mệt ...|||||--=0


Còn xóa Cái Folder thì vầy đi dài dòng chi
Mã: 
     x = DefPath & "\YourAp"
    '''CODE CUA BẠN
    Kill x '''DÒNG NÀY SAU CÙNG
 
Lần chỉnh sửa cuối:
To giaiphap
Mình mới thử lại mấy lần Ok mà
Thử bằng cách trên File bạn Gõ [B2:B] xong tao file Xem ...Mới chỉnh thêm Một tẹo ...cơ bản vẫn vậy
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ExitSub ''Coded By Kieu Manh - GPE
Dim MyTab As String: MyTab = "Book" & GetRandName()                 ''//Tao Tab Ngau nhien ko trung
Dim MyID As String: MyID = "WL" & MyCount()                         ''//Ten ID cac Tab con Cong them 1
Application.EnableEvents = False
    If Not Intersect([B2:B300], Target) Is Nothing Then
        If Target.Offset(, 6).Value = Empty Then
            Target.Offset(, 6).Value = "OldMenu"                    ''//Neu Bo trong ta cho Mat cuoi Vao Do cho ko Loi Code
        End If
        If Target.Value = 1 Then                                    ''//Ap dung cho Tao 1 Tab Moi tren Menu Ribbon
            With Target
                If .Offset(, 2) <> Empty Then                       ''//Xu ly loi khi chua dat ten - Lable
                    If Target.Value = Target.Offset(-1) Then
                        Target.Value = 2: Target.Select             ''//Xu ly loi khi tao moi 2 Tab lien Tiep [MyTab]
                        MsgBox "Error ... Create Tab Ribbon", 64, "Thông Báo"
                        GoTo ExitSub:
                    End If
                    .Offset(, -1).Value = MyTab                     ''//Ten Tab moi tren Menu Ribbon
                    .Offset(, -1).Interior.ColorIndex = 6           ''//To Mau cho de nhin va Kiem soat loi
                    .Offset(, 1).Value = Empty
                    .Offset(, 2).Interior.ColorIndex = 6            ''//To Mau cho de nhin va Kiem soat loi
                    .Offset(, 3).Value = Empty
                    .Offset(, 4).Value = Empty
                    .Offset(, 5).Value = GetRandName                ''//Key Tip Cua MyTab bat buoc phai co ...Tao So ngau nhien
                    .Offset(1).Value = 2: Target.Offset(1).Select   ''//Goi Y Tao Tab Theo Code...Neu khong Theo trinh tu La Error...
                Else
                    Target.Value = Empty: Target.Offset(, 2).Select
                    MsgBox "Ban Bo Trong Ten - Label ...Error", 64, "Thông Báo"
                End If
            End With
        ElseIf Target.Value = 2 Then                                ''//Ap dung cho Tao Nhieu Tab trong 1 Tab [Group = Nhieu Tab]
            With Target
                If .Offset(, 2) <> Empty Then
                    If Target.Value = Target.Offset(-1) Then
                        Target.Value = 3: Target.Select             ''//Xu ly loi khi tao moi 2 Tab [Group]...[2 So 2] lien Tiep
                        MsgBox "Error ... Create Tab Ribbon", 64, "Thông Báo"
                        GoTo ExitSub: ''//Neu tren 2 La Loi Menu Ribbon Bat Buot Phai la 3
                    End If
                    .Offset(, -1).Interior.ColorIndex = 8           ''//To Mau cho de nhin va Kiem soat loi
                    .Offset(, -1).Value = MyID
                    .Offset(, 1).Value = Empty
                    .Offset(, 2).Interior.ColorIndex = 8            ''//To Mau cho de nhin va Kiem soat loi
                    .Offset(, 3).Value = Empty
                    .Offset(, 4).Value = Empty
                    .Offset(, 5).Value = Empty
                    .Offset(1).Value = 3: Target.Offset(1).Select   ''//Goi Y Tao Tab Theo Code ...Neu khong Theo trinh tu La Error...
                Else
                    Target.Value = Empty: Target.Offset(, 2).Select
                    MsgBox "Ban Bo Trong Ten - Label ...Error", 64, "Thông Báo"
                End If
            End With
        ElseIf Target.Value = 3 Then                                        ''//Ap dung cho Tao 1 Button rieng le
            With Target
                If Target.Value - Target.Offset(-1) > 1 Then
                    Target.Value = 2: Target.Select                         ''//Xu ly loi khi tao moi [MyTab 1] ma chua Tao Tab Con [2]
                    MsgBox "Error ... Create Tab Ribbon", 64, "Thông Báo"
                    GoTo ExitSub: ''//Tab 1 = Cha; 2 = con ...Co 1 moi Co 2 Neu nhay xuong 3 la Loi Menu Ribbon
                End If
                If .Offset(, 2) <> Empty Then                               ''//Xu ly loi khi bo trong Lable - Ten
                    If .Offset(, 3) <> Empty Then                           ''//Xu ly loi khi bo trong Ghi Chu - Ben duoi Ten
                        If .Offset(, 4) <> Empty Then                       ''//Xu ly loi khi bo trong SuperTip - Comment
                            .Offset(, -1).Interior.ColorIndex = xlNone      ''//Xoa To Mau
                            .Offset(, -1).Value = MyID
                            .Offset(, 1).Value = "large"                    ''//Size large = To; normal = Nho
                            .Offset(, 2).Interior.ColorIndex = xlNone
                            .Offset(, 5).Value = GetRandName                ''//Tao Key Tip ngau nhien
                        Else
                            Target.Value = Empty: Target.Offset(, 4).Select
                            MsgBox "Ban Bo Trong Screen Tip ...Error", 64, "Thông Báo"
                        End If
                    Else
                        Target.Value = Empty: Target.Offset(, 3).Select
                        MsgBox "Ban Bo Trong Screen Tip ...Error", 64, "Thông Báo"
                    End If
                Else
                    Target.Value = Empty: Target.Offset(, 2).Select
                    MsgBox "Ban Bo Trong Ten - Label ...Error", 64, "Thông Báo"
                End If
            End With
        Else
            Target.Value = Empty: Target.Select                             ''//Xoa du lieu Sai
            MsgBox "Chi Duoc Nhap 1, 2 Hoac 3", 64, "Thông Báo"             ''//Thong bao du lieu Sai
        End If
    End If
ExitSub:                                                                    ''//Xu ly Loi ...
Range("A2").Value = "WALL"                                                  ''//Ten Tab moi dau Tien ...
Application.EnableEvents = True
End Sub

''// Den Tang Dan luu trong Registry
Public Function MyCount() As Long
    Dim lCounts As Long 
    Application.Volatile
    lCounts = GetSetting("MyCount", "Settings", "Counts", 0) + 1
    SaveSetting "MyCount", "Settings", "Counts", lCounts
    MyCount = lCounts
    If lCounts > 1000 Then DeleteSetting "MyCount", "Settings", "Counts"
End Function


''// Tao So Ngau Nhien
Public Function GetRandName() As String
    ''//Tao so Ngau Nhien  ...This Code Copy Form - GPE
    GetRandName = Mid(CreateObject("Scripting.FileSystemObject").GetTempName, 4, 2)
End Function
 
Lần chỉnh sửa cuối:
Nếu làm theo cách của Giaiphap thì đơn gian Vậy đi

Mình tách ra mấy bước cho dễ hiểu cơ bản là vậy ... còn ta gộp lại 1 Sub là xong

Mã: 
Public Sub DeleteFiles(ByVal FileDel As String)
    With CreateObject("Scripting.FileSystemObject")
        If .FileExists(FileDel) Then .DeleteFile FileDel
        If .FolderExists(FileDel) Then .DeleteFolder (FileDel)
    End With
End Sub
Public Sub CreateFolders(ByVal MyFolder As String)
    With CreateObject("Scripting.FileSystemObject")
        If Not .FolderExists(MyFolder) Then .CreateFolder (MyFolder)
    End With
End Sub
Public Function MoveFiles(ByVal FileNguon As String, ByVal FileDich As String) As Boolean
    With CreateObject("scripting.filesystemobject")
        If .FileExists(FileNguon) Then .Movefile (FileNguon), (FileDich)
    End With
End Function


''// Buoc 1
Sub MoveFilesToZip()
    Dim FileExcel As String, szip, EmptyZip
    FileExcel = ThisWorkbook.Path & "\YourApp.xlsm"
    szip = ThisWorkbook.Path & "\Moi.zip"
    EmptyZip = ThisWorkbook.Path & "\YourAppNew.zip"
    MoveFiles FileExcel, szip
    NewZip EmptyZip
End Sub


''// Buoc 2
Sub Unzip_CreateXML()
    Dim MyFolder, FileName
    Dim UI As String, XML As Worksheet, i As Long
    UI = ThisWorkbook.Path & "\NewApp\customUI\customUI14.xml"
    MyFolder = ThisWorkbook.Path & "\NewApp"
    CreateFolders MyFolder
    FileName = ThisWorkbook.Path & "\Moi.zip"
    Unzip MyFolder, FileName
    Set XML = ThisWorkbook.Worksheets("XML")
        With CreateObject("Scripting.FileSystemObject")
            With .CreateTextFile(UI, True, True)
                For i = 1 To 1000
                    .WriteLine XML.Cells(i, 1)
                Next
                .Close
            End With
        End With
    Set XML = Nothing
End Sub


''// Buoc 3
Sub CopyToZip()
    Dim filepath, FileName
    filepath = ThisWorkbook.Path & "\NewApp"
    FileName = ThisWorkbook.Path & "\YourAppNew.zip"
    Zip_All_Files_in_Folder_Browse filepath, FileName
End Sub


''// Buoc 4
Sub MoveFiles_ToExcel()
    Dim FileName As String, AppNew As String, MyFolder, szip
    MyFolder = ThisWorkbook.Path & "\NewApp"
    szip = ThisWorkbook.Path & "\Moi.zip"
    FileName = ThisWorkbook.Path & "\YourAppNew.zip"
    AppNew = ThisWorkbook.Path & "\YourApp.xlsm"
    MoveFiles FileName, AppNew
    DeleteFiles MyFolder
    DeleteFiles szip
End Sub
 
Lần chỉnh sửa cuối:
Vậy là Mình đã viết xong Ứng dụng Tạo Menu tiếng việt có dấu cho Office Phát triển từ code của thaipv và các thành viên GPE

Úp lên đây tặng cho Bạn nào cần sử dụng ...

Vậy là chỉ còn ta với ta .... thôi chốt hạ tại đây ... ta đi khai phá vùng đất mới...
Code tự động tạo Ribbon chỉ một nút nhấn là xong ...như sau + ..... chi tiết trong file đính kèm
Mạnh úp file này ở đây và bài #1
Mã: 
Public Sub CreateRibbonMenu()
Application.ScreenUpdating = False
    Call DeleteEmpty ''//Coded By Kieu Manh
    Call XML_Coder
    On Error GoTo ExiSub:
    Dim Txt As Object, MyFolder, NewZip, YourAppNew, CheckErr As Range
    Dim UI As String, MyApp As String, XML As Worksheet, i As Long
    MyApp = ThisWorkbook.Path & "\YourApp.xlsm"
    NewZip = ThisWorkbook.Path & "\NewFile.zip"
    YourAppNew = ThisWorkbook.Path & "\YourAppNew.zip"
    UI = ThisWorkbook.Path & "\NewApp\customUI\customUI14.xml"
    MyFolder = ThisWorkbook.Path & "\NewApp"
    Set XML = ThisWorkbook.Worksheets("XML")
    Set CheckErr = Sheets("MAIN").Range("B65536").End(3)
    If CheckErr = 2 Then                                 ''//Kiem tra loi truoc khi khoi Tao Menu Ribbon
        UniMsgbox CHUYENMA("Dofng Cuoosi B") _
            & CheckErr & " ... Err ...Create Ribbon"
        Call DeleteEmpty                                 ''//Xoa dong thua ben duoi
        GoTo ExiSub:                                     ''//Thoat Khi co loi khoi tao
    End If
    With CreateObject("Scripting.FileSystemObject")
        If .fileexists(MyApp) Then                       ''//Neu File khong ton tai thi Thoat
            .CreateFolder MyFolder                       ''//Tao Folder moi
            .Movefile MyApp, YourAppNew                  ''//Renme File Excel To *.zip
            
            UnZip YourAppNew, MyFolder                   ''//Giai nen File *.zip
            CreateXML XML, UI                            ''//Tao chuoi XML
            ZipFilesInSub MyFolder, NewZip               ''//Nen nhung File Giai nen luc truoc Vao
            
            Application.Wait (Now + 5 / 24 / 60 / 60)    ''//Cho xu ly xong Tinh tiep
            If .fileexists(NewZip) Then
                .Movefile NewZip, MyApp                  ''//Doi lai Sang File Excel YourApp.xlsm
                .DeleteFile YourAppNew                   ''//Xoa File YourAppNew.zip
                .DeleteFolder MyFolder                   ''//Xoa Folder NewApp
            End If
            UniMsgbox CHUYENMA("DDax Thuwjc Hieejn Khowri Tajo Menu Xong")
            OpenFile (MyApp)                             ''//Open File vua khoi tao Menu Ribbon
            ActiveWorkbook.Save                          ''//Luu Lai thiet lap sau khi khoi tao
        Else                                             ''//Neu File YourApp.xlsm ko co thi Thoat
            UniMsgbox (MyApp) & vbLf _
                & "File Not Found ... Check File"
        End If
    End With
    Set XML = Nothing: Set Txt = Nothing
ExiSub:
Application.ScreenUpdating = True
End Sub


''// Ghi Chuoi XML vao File customUI14.xml ...
Public Sub CreateXML(SheetName As Worksheet, UI As String)
    Dim i As Long
    With CreateObject("Scripting.FileSystemObject")
        With .CreateTextFile(UI, True, True)
            For i = 1 To 1000
                .WriteLine SheetName.Cells(i, 1)
            Next
            .Close
        End With
    End With
End Sub

code kiểm tra lỗi và gợi ý khởi tạo Menu như sau
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ExitSub ''Coded By Kieu Manh - GPE
Dim MyTab As String: MyTab = "Book" & GetRandName()                         ''//Tao Tab Ngau nhien ko trung
Dim MyID As String: MyID = "WL" & MyCount()                                 ''//Ten ID cac Tab con Cong them 1
Application.EnableEvents = False
    If Not Intersect([B2:B300], Target) Is Nothing Then
        If Target.Offset(, 6).Value = Empty Then
            Target.Offset(, 6).Value = "OldMenu"                            ''//Neu Bo trong ta cho Mat cuoi Vao Do cho ko Loi Code
        End If
        If Target.Value = 1 Then                                            ''//Ap dung cho Tao 1 Tab Moi tren Menu Ribbon
            With Target
                If .Offset(, 2) <> Empty Then                               ''//Xu ly loi khi chua dat ten - Lable
                    If Target.Value = Target.Offset(-1) Then
                        Target.Value = 2: Target.Select                     ''//Xu ly loi khi tao moi 2 Tab lien Tiep [MyTab]
                        UniMsgbox "Error ... Create Tab Ribbon"
                        GoTo ExitSub:
                    End If
                    .Offset(, -1).Value = MyTab                             ''//Ten Tab moi tren Menu Ribbon
                    .Offset(, -1).Interior.ColorIndex = 6                   ''//To Mau cho de nhin va Kiem soat loi
                    .Offset(, 1).Value = Empty
                    .Offset(, 2).Interior.ColorIndex = 6                    ''//To Mau cho de nhin va Kiem soat loi
                    .Offset(, 3).Value = Empty
                    .Offset(, 4).Value = Empty
                    .Offset(, 5).Value = GetRandName                        ''//Key Tip Cua MyTab bat buoc phai co ...Tao So ngau nhien
                    .Offset(, 6).Value = Empty
                    .Offset(, 6).Interior.ColorIndex = 6                    ''//To Mau cho de nhin va Kiem soat loi
                    .Offset(1).Value = 2: Target.Offset(1).Select           ''//Goi Y Tao Tab Theo Code...Neu khong Theo trinh tu La Error...
                Else
                    Target.Value = Empty: Target.Offset(, 2).Select
                    UniMsgbox CHUYENMA("Bajn Bor Troosng Teen - ") _
                        & "Label ...Error Create Ribbon"                    ''//Ban bo trong ten
                End If
            End With
        ElseIf Target.Value = 2 Then                                        ''//Ap dung cho Tao Nhieu Tab trong 1 Tab [Group = Nhieu Tab]
            With Target
                If .Offset(, 2) <> Empty Then
                    If Target.Value = Target.Offset(-1) Then
                        Target.Value = 3: Target.Select                     ''//Xu ly loi khi tao moi 2 Tab [Group]...[2 So 2] lien Tiep
                        UniMsgbox "Error ... Create Tab Ribbon"
                        GoTo ExitSub:                                       ''//Neu tren 2 La Loi Menu Ribbon Bat Buot Phai la 3
                    End If
                    .Offset(, -1).Interior.ColorIndex = 8                   ''//To Mau cho de nhin va Kiem soat loi
                    .Offset(, -1).Value = MyID
                    .Offset(, 1).Value = Empty
                    .Offset(, 2).Interior.ColorIndex = 8                    ''//To Mau cho de nhin va Kiem soat loi
                    .Offset(, 3).Value = Empty
                    .Offset(, 4).Value = Empty
                    .Offset(, 5).Value = Empty
                    .Offset(, 6).Interior.ColorIndex = 8                    ''//To Mau cho de nhin va Kiem soat loi
                    .Offset(1).Value = 3: Target.Offset(1).Select           ''//Goi Y Tao Tab Theo Code ...Neu khong Theo trinh tu La Error...
                Else
                    Target.Value = Empty: Target.Offset(, 2).Select
                    UniMsgbox CHUYENMA("Bajn Bor Troosng Teen - ") _
                        & "Label ...Error Create Ribbon"                    ''//Ban bo trong ten
                End If
            End With
        ElseIf Target.Value = 3 Then                                        ''//Ap dung cho Tao 1 Button rieng le
            With Target
                If Target.Value - Target.Offset(-1) > 1 Then
                    Target.Value = 2: Target.Select                         ''//Xu ly loi khi tao moi [MyTab 1] ma chua Tao Tab Con [2]
                    UniMsgbox "Error ... Create Tab Ribbon"
                    GoTo ExitSub:                                           ''//Tab 1 = Cha; 2 = con ...Co 1 moi Co 2 Neu nhay xuong 3 la Loi Menu Ribbon
                End If
                If .Offset(, 2) <> Empty Then                               ''//Xu ly loi khi bo trong Lable - Ten
                    If .Offset(, 3) <> Empty Then                           ''//Xu ly loi khi bo trong Ghi Chu - Ben duoi Ten
                        If .Offset(, 4) <> Empty Then                       ''//Xu ly loi khi bo trong SuperTip - Comment
                            .Offset(, -1).Interior.ColorIndex = xlNone      ''//Xoa To Mau
                            .Offset(, -1).Value = MyID
                            .Offset(, 1).Value = "large"                    ''//Size large = To; normal = Nho
                            .Offset(, 2).Interior.ColorIndex = xlNone
                            .Offset(, 5).Value = GetRandName                ''//Tao Key Tip ngau nhien
                        Else
                            Target.Value = Empty: Target.Offset(, 4).Select
                            UniMsgbox CHUYENMA("Bajn Bor Troosng Teen - ") _
                                & "Screen Tip ...Error Create Ribbon"       ''//Ban bo trong Screen Tip
                        End If
                    Else
                        Target.Value = Empty: Target.Offset(, 3).Select
                        UniMsgbox CHUYENMA("Bajn Bor Troosng Teen - ") _
                                & "Screen Tip ...Error Create Ribbon"       ''//Ban bo trong Screen Tip
                    End If
                Else
                    Target.Value = Empty: Target.Offset(, 2).Select
                    UniMsgbox CHUYENMA("Bajn Bor Troosng Teen - ") _
                        & "Label ...Error Create Ribbon"                    ''//Ban bo trong ten
                End If
            End With
        Else
            Target.Value = Empty: Target.Select                             ''//Xoa du lieu Sai
            UniMsgbox CHUYENMA("Bajn Chir DDuwowjc Nhaajp 1, 2 Hoawjc 3")   ''//Thong bao du lieu Sai
        End If
    End If
ExitSub:                                                                    ''//Xu ly Loi ...
Range("A2").Value = "WALL"                                                  ''//Ten Tab moi dau Tien ...
Application.EnableEvents = True
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Hay quá bác KieuManh ơi, nghiên cứu tiếp đi bác. Tiện ích còn nghèo về nút lệnh quá (Chỉ 1 loại Button thôi), thêm các loại khác đi bác. VD DropDown, CheckBox, EditBox, Label, Menu, Split Button, Toggle Button,...
 
giaiphap đã viết:
Hay quá bác KieuManh ơi, nghiên cứu tiếp đi bác. Tiện ích còn nghèo về nút lệnh quá (Chỉ 1 loại Button thôi), thêm các loại khác đi bác. VD DropDown, CheckBox, EditBox, Label, Menu, Split Button, Toggle Button,...
Nhấp chuột vào đây để mở rộng...
Mình sử dụng Fso ghi vào File Help.txt tiếng Việt Unicode có dấu không Biết Bạn tải về máy có lỗi Font ko vậy

Lưu ý: Cho Bạn Nào tạo Menu mà Cells [B2] gõ là 2 hay 3 là Tèo ....Bắt Buộc phải là 1

Nếu chắc cú thêm dòng sau dưới cùng Sự kiện Change
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
‘’’’’’’’’’’’’’’’’’’’’’’’code két 
[COLOR=#ff0000][SIZE=3][B]Range("B2").Value = 1’’Nó đây nha[/B][/SIZE][/COLOR]
Application.EnableEvents = True
End Sub


 
Trong khi đợi bác KieuManh ra tay thì cho tiểu đệ vọc chút vậy. Thêm vào checkBox, labelControl, editBox, button, separator, đây chỉ là ý tưởng thôi, muốn sử dụng tốt phải sửa chửa nhiều hơn.
 

File đính kèm

giaiphap đã viết:
Trong khi đợi bác KieuManh ra tay thì cho tiểu đệ vọc chút vậy. Thêm vào checkBox, labelControl, editBox, button, separator, đây chỉ là ý tưởng thôi, muốn sử dụng tốt phải sửa chửa nhiều hơn.
Nhấp chuột vào đây để mở rộng...
Để bắt đầu làm việc ta thống nhất lại 1 vài cái xem tình hình sao ...xong tính tiếp

1/ để chèn code vào File khác bắt buột ta phải Trust access to the VBA project model ....nếu ko thì Tèo
Mình xài thì ko sao còn ai đó chưa biết thì tịt ....vì vậy Mình sẻ xài code sau xử lý nó trước khi chèn code vào file YourApp.xlsm

Mã: 
Public Sub ChangeVBOM(ByVal Val As Long)
    Dim AppVer, Regkey As String
    AppVer = Application.Version
    Regkey = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & AppVer & "\Excel\Security\AccessVBOM"
    CreateObject("WScript.Shell").RegWrite Regkey, Val, "REG_DWORD"
End Sub


Public Sub CheckVBOM()
    ChangeVBOM (1)
End Sub


Public Sub UnCheckVBOM()
    ChangeVBOM (2)
End Sub

2/ Bạn giải thích lại trên Sheet MAIN một tí cho rõ như bài #25 thaipv giải thích đó ....

tại vì mình mới vọc Menu này mới có hơn 1 tuần gì đó nên chưa thật sự hiểu lắm...

3/ Tại sao cột k,m và L lại để trống .... ta không cho hết vào đó xong ta nghiên cứu luôn một cái nó xử hết luôn
 
Lần chỉnh sửa cuối:
kieu manh đã viết:
Để bắt đầu làm việc ta thống nhất lại 1 vài cái xem tình hình sao ...xong tính tiếp

1/ để chèn code vào File khác bắt buột ta phải Trust access to the VBA project model ....nếu ko thì Tèo
Vấn đề mình xài thì ko sao còn ai đó chưa biết thì tịt ....vì vậy Mình sẻ xài code sau xử lý nó trước khi chèn code vào file YourApp.xlsm

2/ Bạn giải thích lại trên Sheet MAIN một tí cho rõ như bài #25 thaipv giải thích đó ....

tại vì mình mới vọc Menu này mới có hơn 1 tuần gì đó nên chưa thật sự hiểu lắm...

3/ Tại sao cột k,m và L lại để trống .... ta không cho hết vào đó xong ta nghiên cứu luôn một cái nó xử hết luôn
Nhấp chuột vào đây để mở rộng...
1. Thống nhất với bác KieuManh.
2. Thật ra ở Sheet Main để hoàn thiện thì cần cải thiện lại chút (có thể sắp xếp thứ tự các cột lại). Theo tôi nên để cột ToolBox (Hiện tại là cột I) ở đầu, tiếp theo sau khi chọn ToolBox thì mới tính đến chuyện Level (hiện tại là cột B) hiện tại chỉ chọn 1, 2 hoặc 3 (theo tôi còn hơn nửa VD 4, 5, 6... Do Menu đa cấp hoặc dropdown) còn các cột còn lại sẽ nhiều hơn do mỗi đối tượng (Checkbox, Editbox, label, button,...) sẽ có những tham số riêng. Vì vậy mình sẽ viết sự kiện thay đổi giá trị của sheet Main sau khi chọn ToolBox thì những cột nào sẽ cho nhập (Dựa vào những giá trị của ToolBox, VD nếu là label thì cột imageMso không cần gõ, có thể đánh dấu bằng màu sắc).
3. Cột K, M, L mình chưa sử dụng, chỉ tạo cột N là các đối tượng để chọn cho cột I (Dùng Data Validation cho người dùng chọn cho dễ).
Trên là ý tưởng của riêng mình nhưng do sửa các cột thì sẽ sửa luôn code nên lười quá để vậy dùng luôn cho nhanh, nên về mặt ngăn nắp thì chưa đảm bảo.
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

GPE-Trợ Lý
[GPE] TALK SHOW EXCEL TRONG SẢN XUẤT
Trả lời
0
Đọc
11
GPE-Trợ Lý
GPE-Trợ Lý
T
Bảng tính trợ cấp tinh giản biên chế theo NĐ 108
    • Thích
Trả lời
3
Đọc
997
trung_bhxh
T
T
Bảng tính trợ cấp theo Nghị định 178 và tính lương hưu
Trả lời
0
Đọc
17
trung_bhxh
T
L
Viết phần mềm đánh lô bằng Visual Basic
    • Thích
2 3
Trả lời
52
Đọc
103K
khanhvinhdai1
K
Mewwo98
Thay dấu ngăn cách sau chữ số hàng nghìn, hàng triệu, hàng tỷ trong Mail Merge
Trả lời
5
Đọc
82
ptm0412
ptm0412
Huyen9
Lỗi không mailings được.
Trả lời
3
Đọc
62
vanle33
vanle33
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
14 15 16
Trả lời
310
Đọc
23K
kunkoi9390
K
K
Có ai giúp mình lấy kết quả xổ số miền nam về file excel
Trả lời
0
Đọc
25
khanhvinhdai1
K
ptm0412
  • Question Question
Lấy dữ liệu web nhiều trang về file Excel bằng Power Query
    • Thích
Trả lời
5
Đọc
2K
ptm0412
ptm0412
H
Công thức tìm kết quả
Trả lời
11
Đọc
119
VetMini
V
V
Hàm dò tìm lấy giá trị của lần xuất hiện thứ n trong excel.
Trả lời
9
Đọc
1K
VetMini
V
N
Nhờ các anh chỉ chỉnh lỗi giúp em với ạ, em cảm ơn ạ.
Trả lời
3
Đọc
77
minhminh27
minhminh27
T
File quản lý thiết bị trong trường học!
Trả lời
4
Đọc
136
VetMini
V
Xoainon3005
Xin file mẫu kế hoạch sản xuất theo tháng ngành động cơ
Trả lời
1
Đọc
123
VetMini
V
Momominh
Sơ đồ hàng hóa trong Container
Trả lời
3
Đọc
125
VetMini
V
hungtin1997
  • Question Question
[Hỏi] Tạo Hyperlink đến ô chạy ngang theo cột
Trả lời
6
Đọc
413
A HOANG 620
A
LuuAnh980
Add in tạo QR code miễn phí.
Trả lời
14
Đọc
556
htin1997
htin1997
tramcannt
Các bác cho hỏi làm cách nào để thu nhỏ thanh công thức này với ạ. Em cảm ơn.
Trả lời
2
Đọc
58
Nhattanktnn
Nhattanktnn
S
  • Question Question
Điều chỉnh kích thước dòng tự động theo trang in
Trả lời
5
Đọc
146
HUONGHCKT
H
A
Tạo vé Loto bằng Excel
2
Trả lời
20
Đọc
23K
Tuấn tata
Tuấn tata
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới Ất Tỵ 2025
Back
Top Bottom