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í ....
Cách sử dụng Ribbon Creator : (Thiết kế Ribbon trên sheet MAIN để làm)
Cái này mình chưa nghĩ tới.
Cảm Ơn Bạn
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 FunctionPrivate 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 FunctionTừ 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
....
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.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 ....
làm nhiều thao tác biếng quá...giaiphap thử cho mạnh coi một tí nha
để mình Nghiên cứu xem mình viết code này giống Bạn
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
x = DefPath & "\YourAp"
'''CODE CUA BẠN
Kill x '''DÒNG NÀY SAU CÙNGPrivate 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 FunctionPublic 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 SubPublic 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 SubPrivate 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 SubMì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
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 SubKhông hề bị lỗi bạn, vẫn xem được tố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
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 Sub1. Thống nhất với bác KieuManh.
