Function oveMarks2(ByVal Text As String) As String
Dim CharCode, i As Long
Dim ResText As String, sTmp As String
On Error Resume Next
sTmp = Text
CharCode = Array(7855, 7857, 7859, 7861, 7863, 7845, 7847, 7849, 7851, 7853, 225, _
224, 7843, 227, 7841, 259, 226, 273, 7871, 7873, 7875, 7877, 7879, _
233, 232, 7867, 7869, 7865, 234, 237, 236, 7881, 297, 7883, 7889, _
7891, 7893, 7895, 7897, 7899, 7901, 7903, 7905, 7907, 243, 242, _
7887, 245, 7885, 244, 417, 7913, 7915, 7917, 7919, 7921, 250, _
249, 7911, 361, 7909, 432, 253, 7923, 7927, 7929, 7925)
ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
For i = 0 To UBound(CharCode)
sTmp = Replace(sTmp, ChrW(CharCode(i)), Mid(ResText, i + 1, 1))
sTmp = Replace(sTmp, UCase(ChrW(CharCode(i))), UCase(Mid(ResText, i + 1, 1)))
Next
oveMarks2 = sTmp
End Function
Function Filter2DArray2(ByVal SourceArray, ByVal ColIndex As Long, ByVal FindStr As String, ByVal HasTitle As Boolean)
Dim aTmpArr, i As Long, j As Long, arr, dic, TmpStr, Tmp, Chk As Boolean, TmpVal As Double
On Error Resume Next
Set dic = CreateObject("Scripting.Dictionary")
aTmpArr = SourceArray
ColIndex = ColIndex + LBound(aTmpArr, 2) - 1
Chk = (InStr("><=", Left(FindStr, 1)) > 0)
For i = LBound(aTmpArr, 1) - HasTitle To UBound(aTmpArr, 1)
If Chk And FindStr <> "" Then
TmpVal = CDbl(aTmpArr(i, ColIndex))
If Evaluate(TmpVal & FindStr) Then dic.Add i, ""
Else
If Left(FindStr, 1) = "!" Then
If Not (UCase(aTmpArr(i, ColIndex)) Like UCase(Mid(FindStr, 2, Len(FindStr)))) Then dic.Add i, ""
Else
If UCase(aTmpArr(i, ColIndex)) Like UCase(FindStr) Then dic.Add i, ""
End If
End If
Next
If dic.Count > 0 Then
Tmp = dic.Keys
ReDim arr(LBound(aTmpArr, 1) To UBound(Tmp) + LBound(aTmpArr, 1) - HasTitle, LBound(aTmpArr, 2) To UBound(aTmpArr, 2))
For i = LBound(aTmpArr, 1) - HasTitle To UBound(Tmp) + LBound(aTmpArr, 1) - HasTitle
For j = LBound(aTmpArr, 2) To UBound(aTmpArr, 2)
arr(i, j) = aTmpArr(Tmp(i - LBound(aTmpArr, 1) + HasTitle), j)
Next
Next
If HasTitle Then
For j = LBound(aTmpArr, 2) To UBound(aTmpArr, 2)
arr(LBound(aTmpArr, 1), j) = aTmpArr(LBound(aTmpArr, 1), j)
Next
End If
End If
Filter2DArray2 = arr
End Function
Sub OriginPriArray()
priArray = Sheet7.Range("C7:E" & Sheet7.Range("C" & Rows.Count).End(xlUp).Row).Value2
End Sub
Sub A_HuongDan()
Dim Sh As String
Application.ScreenUpdating = False
Sh = ActiveSheet.Name
Sheet2.Activate
ActiveSheet.Shapes("Object 6").Select
Selection.Verb Verb:=xlPrimary
Sheets(Sh).Activate
[C1].Activate
End Sub
Sub B_HuongDan()
Dim Sh As String
ActiveSheet.Shapes("Object 6").Select
Selection.Verb Verb:=xlPrimary
End Sub
Sub ThayScreenTip_Menu()
Dim arrObj, Obj, arrTxt, i As Long
Dim txtN As String, txtX As String, txtTC As String, txtIn As String, txtVT As String, txtKHH As String
Dim txtKoH As String, txtLD As String, txtNXT As String, txtBCK As String, txtXem As String
txtN = "Nh" & ChrW(7853) & "p kho v" & ChrW(7853) & "t t" & ChrW(432)
txtX = "Xu" & ChrW(7845) & "t kho v" & ChrW(7853) & "t t" & ChrW(432)
txtTC = "Thu chi khách hàng"
txtIn = "In phi" & ChrW(7871) & "u nh" & ChrW(7853) & "p, phi" & ChrW(7871) & "u xu" & ChrW(7845) & "t"
txtVT = "Danh m" & ChrW(7909) & "c v" & ChrW(7853) & "t t" & ChrW(432)
txtKHH = "Danh m" & ChrW(7909) & "c khách hàng, nhà cung c" & ChrW(7845) & "p"
txtKoH = "Danh m" & ChrW(7909) & "c kho hàng"
txtLD = "Danh m" & ChrW(7909) & "c l" & ChrW(253) & " do nh" & ChrW(7853) & "p xu" & ChrW(7845) & "t"
txtNXT = "Báo cáo nh" & ChrW(7853) & "p xu" & ChrW(7845) & "t - S" & ChrW(7893) & " chi ti" & ChrW(7871) & "t v" & ChrW(7853) & "t t" & ChrW(432)
txtBCK = "Báo cáo bán hàng, công n" & ChrW(7907)
'txtHD = "H" & ChrW(432) & ChrW(7899) & "ng d" & ChrW(7851) & "n s" & ChrW(7917) & " d" & ChrW(7909) & "ng"
txtXem = "Xem trang k" & ChrW(7871) & "t qu" & ChrW(7843) & " báo cáo"
arrObj = Array("Rectangle 19", "Rectangle 20", "Rectangle 32", "Rectangle 23", "Rectangle 24", "Rectangle 28", _
"Rectangle 27", "Rectangle 29", "Rectangle 21", "Rectangle 22", "Rectangle 31")
arrTxt = Array(txtN, txtX, txtTC, txtIn, txtVT, txtKHH, txtKoH, txtLD, txtNXT, txtBCK, txtXem)
For Each Obj In arrObj
i = i + 1
ActiveSheet.Shapes.Range(Array(Obj)).Select
Selection.ShapeRange.Item(1).Hyperlink.ScreenTip = arrTxt(i)
Next
End Sub
