ASAP Utilities

Thảo luận trong 'Ứng dụng Excel' bắt đầu bởi handung107, 1 Tháng chín 2004.

16,633 lượt xem

  1. handung107

    handung107 Thành viên thân thiết

    Bài viết:
    576
    Đã được thích:
    13
    Nơi ở:
    VN
    Mình vừa Download file ASAP UTilities mà Làm Bạn với Máy Vi tính giới thiệu về hơn 300 tiện ích của Excel. Bạn nào cần thì mình gởi cho
     
    #1
  2. handung107

    handung107 Thành viên thân thiết

    Bài viết:
    576
    Đã được thích:
    13
    Nơi ở:
    VN
    #2
  3. levanduyet

    levanduyet Welcome

    Bài viết:
    535
    Đã được thích:
    11
    Giới tính:
    Nam
    Nơi ở:
    HCM
    Chao cac ban,
    Cac ban co the dung phan mem AVPR de xem source code va hoc hoi (Thay doi password). Xin noi voi cac ban, chang qua day la phan mem mien phi nen...
    Chi de hoc hoi thoi. Cac ban de y la khi cac ban bung ra vao mot thu muc thi cac ban se thay co nhieu file. Cac ban phai dung AVPR de mo het cac file moi duoc. Cac file nay chi duoc load khi chuong trinh su dung den no. That la tuyet. Nhung chang co thi gio ma xem dau.
    Mot cong cu mien phi lam tang toc do cong viec cua ban len...bao nhieu thi tuy cac ban.
    Chuc cac ban thanh cong.
    levanduyet
     
    #3
  4. levanduyet

    levanduyet Welcome

    Bài viết:
    535
    Đã được thích:
    11
    Giới tính:
    Nam
    Nơi ở:
    HCM
    Chao cac ban, da co phien ban moi cua ASAP.
    ASAP Utilities new version 3.08 released
    15 october 2004
    http://www.asap-utilities.com/
    ....
    Have a good...
    Le Van Duyet
     
    #4
  5. levanduyet

    levanduyet Welcome

    Bài viết:
    535
    Đã được thích:
    11
    Giới tính:
    Nam
    Nơi ở:
    HCM
    Đánh giá phần I:
    Thử tìm hiểu về phiên bản mới của ASAP Utilities Version 3.08, 15/10/2004.
    Range::Find/ replace in all sheet
    Nút Expand, khi lần đầu tiên form hiện ra thì nút này "hình như" không có tác dụng. Các bạn hãy đọc đọan mã dưới đây và tự phân tích xem sao:
    Private Sub cmdExpand_Click()
    Debug.Print Me.Top
    Dim snFactor As Single
    snFactor = 1.3325
    Dim intDefFormHeight As Integer
    Dim intDefListHeight As Integer
    Dim intNewFormHeight As Integer
    Dim intNewListHeight As Integer

    intDefFormHeight = 297
    intDefListHeight = 129
    intNewFormHeight = 297 + (fnGetScreenWidth / snFactor / 5)
    intNewListHeight = intNewFormHeight - 169
    If Me.Height > intDefFormHeight Then
    '??????????????????????????
    Me.Height = intDefFormHeight
    Me.lstFound.Height = intDefListHeight
    cmdExpand.Caption = "Expand >>"
    Else
    Me.Height = intNewFormHeight
    Me.lstFound.Height = intNewListHeight
    cmdExpand.Caption = "<< Smaller"
    End If
    End Sub

    Và sau đây là thủ tục tìm kiếm, cũng rất hay:
    Sub sbFindReplace(strSearch As String, _
    wsstart As Worksheet, _
    strrngStartSearch As String, _
    intLookIn As Integer, _
    blnMatchCase, _
    blnEntireCellsOnly, _
    intSearchOrder As Integer)
    If intLookIn = 0 Then
    varLookIn = xlFormulas
    Else
    varLookIn = xlValues
    End If
    If blnEntireCellsOnly = True Then
    varLookAt = xlWhole
    Else
    varLookAt = xlPart
    End If
    If intSearchOrder = 0 Then
    varSearchOrder = xlByRows
    Else
    varSearchOrder = xlByColumns
    End If
    If strSearch = "" Then Exit Sub
    i = 0
    For Each ws In ActiveWorkbook.Worksheets
    Set rng = ws.Cells.Find(What:=strSearch, _
    After:=ws.Range("A1"), _
    LookIn:=xlFormulas, _
    LookAt:=varLookAt, _
    SearchOrder:=varSearchOrder, _
    SearchDirection:=xlNext, _
    MatchCase:=blnMatchCase)
    If Not rng Is Nothing Then
    firstAddress = rng.Address
    Do
    If Not rng Is Nothing Then
    lstFound.AddItem ws.Name
    lstFound.Column(1, lstFound.ListCount - 1) = rng.Address
    lstFound.Column(2, lstFound.ListCount - 1) = rng.Value
    i = i + 1
    End If
    Set rng = ws.Cells.FindNext(rng)
    Loop Until rng.Address = firstAddress
    End If
    Next ws
    Me.lblItemsFound.Caption = i
    End Sub
    '''''''''''''''''''''
    Sub sbFindReplace2()
    Dim ws As Worksheet
    Dim rng As Range
    Dim strSearch As String
    Dim ans As Variant
    Dim firstAddress As String
    strSearch = InputBox("Find what")
    If strSearch = "" Then Exit Sub
    For Each ws In ActiveWorkbook.Worksheets
    Set rng = ws.Cells.Find(What:=strSearch, _
    After:=ws.Range("A1"), _
    LookIn:=xlFormulas, _
    LookAt:=xlWhole, _
    SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, _
    MatchCase:=False)
    If Not rng Is Nothing Then
    firstAddress = rng.Address
    Do
    If Not rng Is Nothing Then
    Application.GoTo rng, True
    ans = MsgBox("Find Next?", _
    vbYesNo + vbDefaultButton1)
    If ans = vbNo Then Exit Sub
    End If
    Set rng = ws.Cells.FindNext(rng)
    Loop Until rng.Address = firstAddress
    End If
    Next ws
    End Sub
    '''''''''''''''''''''''''''
    Sub sbReplace(blnReplaceAll As Boolean)
    If blnReplaceAll = False And lstFound.ListIndex = -1 Then
    MsgBox "Select an entry to replace.", vbExclamation, AT
    Me.lstFound.SetFocus
    Exit Sub
    End If
    strSearch = Me.txtSearch.Text
    strReplace = Me.txtReplace.Text
    If Me.comLookIn.ListIndex = 0 Then
    varLookIn = xlFormulas
    Else
    varLookIn = xlValues
    End If
    If Me.chkEntireCellsOnly = True Then
    varLookAt = xlWhole
    Else
    varLookAt = xlPart
    End If
    If Me.comSearch.ListIndex = 0 Then
    varSearchOrder = xlByRows
    Else
    varSearchOrder = xlByColumns
    End If
    Application.ScreenUpdating = False
    If blnReplaceAll = False Then
    Sheets(lstFound.List(lstFound.ListIndex, 0)).Select
    Range(lstFound.List(lstFound.ListIndex, 1)).Select
    ActiveCell.Replace strSearch, strReplace, varLookAt,varSearchOrder,
    Me.chkMatchCase
    lstFound.Column(3, lstFound.ListIndex) = "-> " & ActiveCell.Value
    If lstFound.ListIndex < lstFound.ListCount - 1 Then lstFound.ListIndex = lstFound.ListIndex + 1
    Else
    For i = 0 To Me.lblItemsFound.Caption - 1
    Sheets(lstFound.List(i, 0)).Select
    Range(lstFound.List(i, 1)).Select
    ActiveCell.Replace strSearch, strReplace, varLookAt, _
    varSearchOrder,Me.chkMatchCase
    lstFound.Column(3, i) = "-> " & ActiveCell.Value
    Next i
    End If
    ' Nham tang toc do chuong trinh
    Application.ScreenUpdating = True
    End Sub
    Number:: Number to words
    Có thể nói đây là hàm chuyển số thành chữ. Hàm chuyển số thành chữ ở các thứ tiếng: Anh, Đức, Hà Lan.
    Sau đây là module modSpellNumberFuntions của tác giả:
    Option Explicit
    Sub Test()
    ActiveCell.Offset(1, 1).Value = fnSpellNumbersEN(ActiveCell.Value, False, "euro", "euros", "comma", "cent", "cents")
    ActiveCell.Offset(2, 1).Value = fnSpellNumbersEN(ActiveCell.Value, False, "euro", "euros", "point", "cent", "cents")
    ActiveCell.Offset(8, 1).Value = fnSpellNumbersDE(ActiveCell.Value, True, "DM", "DM", "komma", "pfennig", "pfennige")
    ActiveCell.Offset(9, 1).Value = fnSpellNumbersDE(ActiveCell.Value, True, "euro", "euros", "komma", "cent", "cents")
    ActiveCell.Offset(10, 1).Value = fnSpellNumbersDE(ActiveCell.Value, False, "euro", "euros", "komma", "cent", "cents")
    ActiveCell.Offset(11, 1).Value = fnSpellNumbersDE(ActiveCell.Value, False, "euro", "euros", "point", "cent", "cents")
    ActiveCell.Offset(18, 1).Value = fnSpellNumbersNL(ActiveCell.Value, True, "DM", "DM", "komma", "pfennig", "pfennige")
    ActiveCell.Offset(19, 1).Value = fnSpellNumbersNL(ActiveCell.Value, True, "euro", "euros", "komma", "cent", "cents")
    ActiveCell.Offset(20, 1).Value = fnSpellNumbersNL(ActiveCell.Value, False, "euro", "euros", "komma", "cent", "cents")
    ActiveCell.Offset(21, 1).Value = fnSpellNumbersNL(ActiveCell.Value, False, "euro", "euro", "komma", "cent", "cent")
    End Sub
    Function fnSpellNumbersEN( _
    ByVal MyNumber, _
    blnCurrency As Boolean, _
    Optional strSingular As String, _
    Optional strPlural As String, _
    Optional strComma As String, _
    Optional strCentSingular As String, _
    Optional strCentPlural As String _
    )
    Dim Dollars, Cents, Temp
    Dim DecimalPlace, Count
    ReDim Place(9) As String
    Place(2) = " Thousand "
    Place(3) = " Million "
    Place(4) = " Billion "
    Place(5) = " Trillion "
    MyNumber = Trim(Str(MyNumber))
    DecimalPlace = InStr(MyNumber, ".")
    If DecimalPlace > 0 Then
    Cents = fnGetTensEN(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
    MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
    End If
    Count = 1
    Do While MyNumber <> ""
    Temp = fnGetHundredsEN(Right(MyNumber, 3))
    If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
    If Len(MyNumber) > 3 Then
    MyNumber = Left(MyNumber, Len(MyNumber) - 3)
    Else
    MyNumber = ""
    End If
    Count = Count + 1
    Loop
    Select Case Dollars
    Case ""
    If blnCurrency Then Dollars = "No " & strPlural
    Case "One"
    If blnCurrency Then
    Dollars = "One " & strPlural
    Else
    Dollars = "One"
    End If
    Case Else
    If blnCurrency Then
    Dollars = Dollars & " " & strPlural
    Else
    Dollars = Dollars
    End If
    End Select
    Select Case Cents
    Case ""
    If blnCurrency Then Cents = " and No " & strCentPlural
    Case "One"
    If blnCurrency Then
    Cents = " and One " & strCentSingular
    Else
    Cents = " " & strComma & " zero One"
    End If
    Case Else
    If blnCurrency Then
    Cents = " and " & Cents & " " & strCentPlural
    Else
    If fnSmallerAsTenEN(Cents) Then
    Cents = " " & strComma & " zero " & Cents
    Else
    Cents = " " & strComma & " " & Cents
    End If
    End If
    End Select
    fnSpellNumbersEN = Dollars & Cents
    End Function
    Function fnGetHundredsEN(ByVal MyNumber)
    Dim Result As String
    If Val(MyNumber) = 0 Then Exit Function
    MyNumber = Right("000" & MyNumber, 3)
    If Mid(MyNumber, 1, 1) <> "0" Then
    Result = fnGetDigitEN(Mid(MyNumber, 1, 1)) & " Hundred "
    End If
    If Mid(MyNumber, 2, 1) <> "0" Then
    Result = Result & fnGetTensEN(Mid(MyNumber, 2))
    Else
    Result = Result & fnGetDigitEN(Mid(MyNumber, 3))
    End If
    fnGetHundredsEN = Result
    End Function
    Function fnGetTensEN(TensText)
    Dim Result As String
    Result = ""
    If Val(Left(TensText, 1)) = 1 Then
    Select Case Val(TensText)
    Case 10: Result = "Ten"
    Case 11: Result = "Eleven"
    Case 12: Result = "Twelve"
    Case 13: Result = "Thirteen"
    Case 14: Result = "Fourteen"
    Case 15: Result = "Fifteen"
    Case 16: Result = "Sixteen"
    Case 17: Result = "Seventeen"
    Case 18: Result = "Eighteen"
    Case 19: Result = "Nineteen"
    Case Else
    End Select
    Else
    Select Case Val(Left(TensText, 1))
    Case 2: Result = "Twenty "
    Case 3: Result = "Thirty "
    Case 4: Result = "Forty "
    Case 5: Result = "Fifty "
    Case 6: Result = "Sixty "
    Case 7: Result = "Seventy "
    Case 8: Result = "Eighty "
    Case 9: Result = "Ninety "
    Case Else
    End Select
    Result = Result & fnGetDigitEN _
    (Right(TensText, 1))
    End If
    fnGetTensEN = Result
    End Function
    Function fnGetDigitEN(Digit)
    Select Case Val(Digit)
    Case 1: fnGetDigitEN = "One"
    Case 2: fnGetDigitEN = "Two"
    Case 3: fnGetDigitEN = "Three"
    Case 4: fnGetDigitEN = "Four"
    Case 5: fnGetDigitEN = "Five"
    Case 6: fnGetDigitEN = "Six"
    Case 7: fnGetDigitEN = "Seven"
    Case 8: fnGetDigitEN = "Eight"
    Case 9: fnGetDigitEN = "Nine"
    Case Else: fnGetDigitEN = ""
    End Select
    End Function
     
    #5
  6. levanduyet

    levanduyet Welcome

    Bài viết:
    535
    Đã được thích:
    11
    Giới tính:
    Nam
    Nơi ở:
    HCM
    Đánh giá phần II:Private Function fnSmallerAsTenEN(strGetal) As Boolean
    Select Case strGetal
    Case "One": fnSmallerAsTenEN = True
    Case "Two": fnSmallerAsTenEN = True
    Case "Three": fnSmallerAsTenEN = True
    Case "Four": fnSmallerAsTenEN = True
    Case "Five": fnSmallerAsTenEN = True
    Case "Six": fnSmallerAsTenEN = True
    Case "Seven": fnSmallerAsTenEN = True
    Case "Eight": fnSmallerAsTenEN = True
    Case "Nine": fnSmallerAsTenEN = True
    Case Else: fnSmallerAsTenEN = False
    End Select
    End Function
    Function fnSpellNumbersDE( _
    ByVal MyNumber, _
    blnCurrency As Boolean, _
    Optional strSingular As String, _
    Optional strPlural As String, _
    Optional strComma As String, _
    Optional strCentSingular As String, _
    Optional strCentPlural As String _
    )
    Dim Temp
    Dim DM, Pfennige
    Dim DecimalPlace, Count
    ReDim Place(9) As String
    Place(2) = "tausend"
    Place(3) = "millionen"
    Place(4) = "milliarden"
    Place(5) = "billiarden"
    MyNumber = Trim(Str(MyNumber))
    DecimalPlace = InStr(MyNumber, ".")
    If DecimalPlace > 0 Then
    Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
    Pfennige = fnConvertTensDE(Temp)
    MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
    End If
    Count = 1
    Do While MyNumber <> ""
    Temp = fnConvertHundredsDE(Right(MyNumber, 3))
    If Temp <> "" Then DM = Temp & Place(Count) & DM
    If Len(MyNumber) > 3 Then
    MyNumber = Left(MyNumber, Len(MyNumber) - 3)
    Else
    MyNumber = ""
    End If
    Count = Count + 1
    Loop
    Select Case DM
    Case ""
    If blnCurrency = True Then
    DM = "keine " & strSingular
    Else
    DM = ""
    End If
    Case "Eins"
    If blnCurrency = True Then
    DM = "eine " & strSingular
    Else
    DM = "eins"
    End If
    Case Else
    If blnCurrency = True Then
    DM = DM & " " & strPlural
    End If
    End Select
    Select Case Pfennige
    Case ""
    If blnCurrency = True Then
    Pfennige = " und keine " & strCentPlural
    End If
    Case "Ein"
    If blnCurrency = True Then
    Pfennige = " und ein " & strCentSingular
    Else
    Pfennige = " " & strComma & " nul eins"
    End If
    Case Else
    If blnCurrency = True Then
    Pfennige = " und " & Pfennige & " " & strCentPlural
    Else
    If fnSmallerAsTenDE(Pfennige) Then
    Pfennige = " " & strComma & " nul " & Pfennige
    Else
    Pfennige = " " & strComma & " " & Pfennige
    End If
    End If
    End Select
    fnSpellNumbersDE = DM & Pfennige
    End Function
    Private Function fnConvertHundredsDE(ByVal MyNumber)
    Dim Result As String
    If Val(MyNumber) = 0 Then Exit Function
    MyNumber = Right("000" & MyNumber, 3)
    If Left(MyNumber, 1) <> "0" Then
    Result = fnConvertDigitDE(Left(MyNumber, 1)) & "hundert"
    End If
    If Mid(MyNumber, 2, 1) <> "0" Then
    Result = Result & fnConvertTensDE(Mid(MyNumber, 2))
    Else
    Result = Result & fnConvertDigitDE(Mid(MyNumber, 3))
    End If
    fnConvertHundredsDE = Trim(Result)
    End Function
    Private Function fnConvertTensDE(ByVal MyTens)
    Dim Result As String
    If Val(Left(MyTens, 1)) = 1 Then
    Select Case Val(MyTens)
    Case 10: Result = "zehn"
    Case 11: Result = "elf"
    Case 12: Result = "zwölf"
    Case 13: Result = "dreizehn"
    Case 14: Result = "vierzehn"
    Case 15: Result = "fünfzehn"
    Case 16: Result = "sechzehn"
    Case 17: Result = "siebzehn"
    Case 18: Result = "achtzehn"
    Case 19: Result = "neunzehn"
    Case Else
    End Select
    Else
    Select Case Val(Left(MyTens, 1))
    Case 2: Result = "zwanzig "
    Case 3: Result = "dreißig "
    Case 4: Result = "vierzig "
    Case 5: Result = "fünfzig "
    Case 6: Result = "sechzig "
    Case 7: Result = "siebzig "
    Case 8: Result = "achtzig "
    Case 9: Result = "neunzig "
    Case Else
    End Select
    End If
    If Val(Left(MyTens, 1)) = 0 And Val(Right(MyTens, 1)) <> 0 Then Result = Result & fnConvertDigitDE(Right(MyTens, 1))
    If Val(Left(MyTens, 1)) <> 0 And Val(Right(MyTens, 1)) <> 0 And MyTens > 19 Then Result = fnConvertDigitDE(Right(MyTens, 1)) & "und" & Result
    fnConvertTensDE = Result
    End Function
    Private Function fnConvertDigitDE(ByVal MyDigit)
    Select Case Val(MyDigit)
    Case 1: fnConvertDigitDE = "ein"
    Case 2: fnConvertDigitDE = "zwei"
    Case 3: fnConvertDigitDE = "drei"
    Case 4: fnConvertDigitDE = "vier"
    Case 5: fnConvertDigitDE = "fünf"
    Case 6: fnConvertDigitDE = "sechs"
    Case 7: fnConvertDigitDE = "sieben"
    Case 8: fnConvertDigitDE = "acht"
    Case 9: fnConvertDigitDE = "neun"
    Case Else: fnConvertDigitDE = ""
    End Select
    End Function
    Private Function fnSmallerAsTenDE(strGetal) As Boolean
    Select Case strGetal
    Case "ein": fnSmallerAsTenDE = True
    Case "zwei": fnSmallerAsTenDE = True
    Case "drei": fnSmallerAsTenDE = True
    Case "vier": fnSmallerAsTenDE = True
    Case "fünf": fnSmallerAsTenDE = True
    Case "sechs": fnSmallerAsTenDE = True
    Case "sieben": fnSmallerAsTenDE = True
    Case "acht": fnSmallerAsTenDE = True
    Case "neun": fnSmallerAsTenDE = True
    Case Else: fnSmallerAsTenDE = False
    End Select
    End Function
    Function fnSpellNumbersNL( _
    ByVal MyNumber, _
    blnCurrency As Boolean, _
    Optional strSingular As String, _
    Optional strPlural As String, _
    Optional strComma As String, _
    Optional strCentSingular As String, _
    Optional strCentPlural As String _
    )
    Dim Temp
    Dim DM, Pfennige
    Dim DecimalPlace, Count
    ReDim Place(9) As String
    Place(2) = "duizend"
    Place(3) = "miljoen"
    Place(4) = "miljard"
    Place(5) = "biljard"
    MyNumber = Trim(Str(MyNumber))
    DecimalPlace = InStr(MyNumber, ".")
    If DecimalPlace > 0 Then
    Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
    Pfennige = fnConvertTensNL(Temp)
    MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
    End If
    Count = 1
    Do While MyNumber <> ""
    Temp = fnConvertHundredsNL(Right(MyNumber, 3))
    If Temp <> "" Then DM = Temp & Place(Count) & DM
    If Len(MyNumber) > 3 Then
    MyNumber = Left(MyNumber, Len(MyNumber) - 3)
    Else
    MyNumber = ""
    End If
    Count = Count + 1
    Loop
    Select Case DM
    Case ""
    If blnCurrency = True Then
    DM = "geen " & strSingular
    Else
    DM = ""
    End If
    Case "Eins"
    If blnCurrency = True Then
    DM = "één " & strSingular
    Else
    DM = "één"
    End If
    Case Else
    If blnCurrency = True Then
    DM = DM & " " & strPlural
    End If
    End Select
    Select Case Pfennige
    Case ""
    If blnCurrency = True Then
    Pfennige = " en nul " & strCentPlural
    Else
    Pfennige = " " & strComma & " nul "
    End If
    Case "Ein"
    If blnCurrency = True Then
    Pfennige = " en een " & strCentSingular
    Else
    Pfennige = " " & strComma & " nul één"
    End If
    Case Else
    If blnCurrency = True Then
    Pfennige = " en " & Pfennige & " " & strCentPlural
    Else
    If fnSmallerAsTenNL(Pfennige) Then
    Pfennige = " " & strComma & " nul " & Pfennige
    Else
    Pfennige = " " & strComma & " " & Pfennige
    End If
    End If
    End Select
    fnSpellNumbersNL = DM & Pfennige
    End Function
    Private Function fnConvertHundredsNL(ByVal MyNumber)
    Dim Result As String
    If Val(MyNumber) = 0 Then Exit Function
    MyNumber = Right("000" & MyNumber, 3)
    If Left(MyNumber, 1) <> "0" Then
    Result = fnConvertDigitNL(Left(MyNumber, 1)) & "honderd"
    End If
    If Mid(MyNumber, 2, 1) <> "0" Then
    Result = Result & fnConvertTensNL(Mid(MyNumber, 2))
    Else
    Result = Result & fnConvertDigitNL(Mid(MyNumber, 3))
    End If
    fnConvertHundredsNL = Trim(Result)
    End Function
    Private Function fnConvertTensNL(ByVal MyTens)
    Dim Result As String
    If Val(Left(MyTens, 1)) = 1 Then
    Select Case Val(MyTens)
    Case 10: Result = "tien"
    Case 11: Result = "elf"
    Case 12: Result = "twaalf"
    Case 13: Result = "dertien"
    Case 14: Result = "veertien"
    Case 15: Result = "vijftien"
    Case 16: Result = "zestien"
    Case 17: Result = "zeventien"
    Case 18: Result = "achttien"
    Case 19: Result = "negentien"
    Case Else
    End Select
    Else
    Select Case Val(Left(MyTens, 1))
    Case 2: Result = "twintig "
    Case 3: Result = "dertig "
    Case 4: Result = "veertig "
    Case 5: Result = "vijftig "
    Case 6: Result = "zestig "
    Case 7: Result = "zeventig "
    Case 8: Result = "tachtig "
    Case 9: Result = "negentig "
    Case Else
    End Select
    End If
    If Val(Left(MyTens, 1)) = 0 And Val(Right(MyTens, 1)) <> 0 Then Result = Result & fnConvertDigitNL(Right(MyTens, 1))
    If Val(Left(MyTens, 1)) <> 0 And Val(Right(MyTens, 1)) <> 0 And MyTens > 19 Then Result = fnConvertDigitNL(Right(MyTens, 1)) & "en" & Result
    fnConvertTensNL = Result
    End Function
    Private Function fnConvertDigitNL(ByVal MyDigit)
    Select Case Val(MyDigit)
    Case 1: fnConvertDigitNL = "één"
    Case 2: fnConvertDigitNL = "twee"
    Case 3: fnConvertDigitNL = "drie"
    Case 4: fnConvertDigitNL = "vier"
    Case 5: fnConvertDigitNL = "vijf"
    Case 6: fnConvertDigitNL = "zes"
    Case 7: fnConvertDigitNL = "zeven"
    Case 8: fnConvertDigitNL = "acht"
    Case 9: fnConvertDigitNL = "negen"
    Case Else: fnConvertDigitNL = ""
    End Select
    End Function
    Private Function fnSmallerAsTenNL(strGetal) As Boolean
    Select Case strGetal
    Case "één": fnSmallerAsTenNL = True
    Case "twee": fnSmallerAsTenNL = True
    Case "drie": fnSmallerAsTenNL = True
    Case "vier": fnSmallerAsTenNL = True
    Case "vijf": fnSmallerAsTenNL = True
    Case "zes": fnSmallerAsTenNL = True
    Case "zeven": fnSmallerAsTenNL = True
    Case "acht": fnSmallerAsTenNL = True
    Case "negen": fnSmallerAsTenNL = True
    Case Else: fnSmallerAsTenNL = False
    End Select
    End Function
    Các bạn hãy tự nghiên cứu nha!
    Objects :: new name : Objects/Comments
    Theo tôi công cụ này cũng hay nhưng chắc có lẻ ích sử dụng.
    Custom functions
    Đưa thêm một hàm cho phép bạn đọc một comment của một ô. Ví dụ:
    =ASAPGetComment(reference), tức là =ASAPGetComment(B1)

    Custom functions
    Đưa thêm một hàm cho phép bạn lấy colornumber của một ô. Điều này sẽ giúp cho bạn khi bạn muốn sắp xếp ô theo màu.
    =ASAPCellColorIndex(reference), tức là =ASAPCellColorIndex(B12)
    System :: Find and remove external links
    Tìm và xóa các links với nguồn ở ngòai.
    Đôi khi các bạn mở một workbook cứ có thông báo update links thật là chán phải không?
    Các bạn hãy dùng công cụ này để tìm kiếm và xóa các links.

    Lê Văn Duyệt
     
    #6
  7. Bình_OverAC

    Bình_OverAC Over Abnormal / Crazy

    Bài viết:
    845
    Đã được thích:
    7
    Nơi ở:
    Nha Trang
    Chào chị handung107,
    em vừa mới download xong cái ASAP nhưng không biết công dụng chính của nó là gì? Chị có thể cho em biết được không?
    Và những điều đặc biệt của nó nữa

    Ai chưa có cái này có thế down load ở đây www.asap-utilities.com
     
    #7
  8. levanduyet

    levanduyet Welcome

    Bài viết:
    535
    Đã được thích:
    11
    Giới tính:
    Nam
    Nơi ở:
    HCM
    Chao cac ban,
    Cac ban doc bai phan tich cua minh ve ASAP.
    Day la cong cu hay tuyet.
    Le Van Duyet
     
    #8
  9. levanduyet

    levanduyet Welcome

    Bài viết:
    535
    Đã được thích:
    11
    Giới tính:
    Nam
    Nơi ở:
    HCM
    #9
  10. levanduyet

    levanduyet Welcome

    Bài viết:
    535
    Đã được thích:
    11
    Giới tính:
    Nam
    Nơi ở:
    HCM
    Chao,
    Sao cac ban khong vao link chinh thuc de download boi vi file cung lon.
    Con ve cach su dung thi...Khi cac ban tu tim hieu...cac ban se kham pha mot the gioi Excel...that la tuyet.
    Cac ban phai "dau tu" thoi. Chi co phuong cach nay cac ban moi...kham pha duoc.
    Chuc cac ban kham pha...nhieu nhieu...
    Le Van Duyet
     
    #10
  11. handung107

    handung107 Thành viên thân thiết

    Bài viết:
    576
    Đã được thích:
    13
    Nơi ở:
    VN
    Các bạn à, địa chỉ link tôi đã chép để các bạn down thẳng từ lâu, nên tôi không gởi riêng cho bạn nào nữa cả, bây giờ bạn levanduyet cũng ghi lại, các bạn cứ theo đó mà tải về. Khi tải về máy của các bạn, các bạn giải nén vào thư mục Add-in của Microsoft Office xong, các bạn sẽ thấy trên thanh công cụ của Excel có Asap Utilities. Qua đó, bạn cứ thử tìm tòi và khám phá. Bạn chỉ cần biết chừng vài chức năng nhỏ như :
    - Bỏ chọn một vài Cell trong một vùng đã chọn : Td bạn chọn vùng A1:C50, nhưng lại muốn bỏ vùng B3:C5, A7:B10..., bảo đảm Asap Utilities sẽ đem lại cho bạn một cách dễ dàng bằng chức năng Select/Deselect Cell.
    -Nếu bạn muốn đánh dấu các hàng hay cột bằng cách tô màu các hàng , cột thứ n thì chức năng Columns, Rows/Color each n'th row or column sẽ giúp bạn
    -Nếu bạn muốn tạo cho workbook của bạn một trang Index với các link cho các sheet trong workbook, chức năng Sheets/Create an Index page with all sheet (clickable) sẽ dành cho việc này
    -Nếu bạn muốn sắp xếp các sheet theo thứ tự ABC đã có Sheets/Sort all sheets in alphabetic order
    Thật ra, ngoài Asap Utilities còn rất nhiều cái khác như Excel Utilities tải ở www.appspro.com cũng có những chức năng tương tự. Về Asap Utilities còn nhiều cái hay lắm, mời bạn khám phá từ từ.
    Trước đây, khi tôi giới thiệu về Asap utilities, có bạn đã chê cái bản download này là dở vì chỉ là bản Demo nên chức năng bị hạn chế và đề nghị cung cấp Key để xài bản chính thức, vì thế tôi chờ bạn ấy đưa cho các bạn cái tốt hơn, bản thân tôi cũng muốn có cái "xịn" đó, không hiểu sao bạn Nipvn chỉ nói thế thôi, chứ không thấy gì cả
    To levanduyet : Bạn quả là một chuyên gia về VBA, nhưng đa số WKT là dân không chuyên về lập trình nên mấy cái source code VBA khó hiểu quá, bạn hướng dẫn kỹ hơn và ít ít một, bản thân tôi cũng biết sơ sơ về Visual Basic, mà đọc còn thấy khổ, dù sao cũng rất cám ơn bạn đã giúp tôi hiểu thêm một ít kiến thức về VBA
     
    #11
  12. handung107

    handung107 Thành viên thân thiết

    Bài viết:
    576
    Đã được thích:
    13
    Nơi ở:
    VN
    Có lẽ các bạn cũng đã tìm thấy và đồng ý cùng tôi chức năng bỏ chọn nhiều vùng khác nhau trong một vùng chọn trước của Asap thật là tuyệt, nó giảm công sức cho chúng ta khá nhiều. Hôm nay chúng ta sẽ tìm thêm vài chức năng hữu ích khác.
    - Trong menu Favorite/Expand selection to last row, column hay Select/Expand selection to last row, column cho phép bạn đặt con trỏ ở Cell đầu tiên mà vẫn chọn được một vùng đến hàng hay cột cuối cùng có chứa dữ liệu.
    - Favorites/Move or resize selection cho phép bạn di chuyển vùng chọn lựa qua trái, phải, trên, dưới bằng nút lớn, trong khi với hàng nút nhỏ, bạn có thể chọn thêm từng hàng, cột qua trái, phải, trên, dưới cho vùng chọn của mình
    - Trong vùng chọn bạn cũng có thể lọc ra những Cell chứa những giá trị giống nhau hay khác nhau bằng Select/Select cells in column with same value (below and above active cell) và Select/Select cells in selection where value changes. Và những Cell chứa giá trị Max trong vùng chọn với Select/Select Cell with maximum value
    - Trong Favorites hay Formula/Apply formula to select Cell cho phép bạn áp dụng cùng một công thức cho vùng chọn của mình, còn Favorites hay Formula/Convert formula to their value đúng như cái tên của nó là các cell chọn có công thức sẽ chỉ còn giá trị số học sau khi công thức tính toán đã được thực hiện
    - Với Sheets/Print multiple sheets là thú vị nhất nó cho phép bạn chọn in cùng lúc nhiều Sheets trong workbook, các chức năng khác như Sheets/Add sheet(input box will appear for the name) giúp bạn vừa Insert worksheet vừa đặt tên cho nó (tên được nhập thẳng vào Input box), trong khi Sheets/Add sheets (with the names defined in selected cells) giúp bạn Insert và đặt tên cùng lúc rất nhiều Sheets ( td bạn sẽ đặt tên cho 17 Sheets bằng cách nhập các tên này vào B1:B17, rồi chọn vùng này và gọi chức năng trên, ngay lập tức 17 Sheets sẽ xuất hiện cùng những cái tên có sẵn trong các Cell của vùng B1:B17)
    Đến đây bạn hẳn đã thấy Asap Utilities có nhiều công dụng hay lắm chứ. Hẹn các bạn dịp khác nhé
     
    #12
  13. handung107

    handung107 Thành viên thân thiết

    Bài viết:
    576
    Đã được thích:
    13
    Nơi ở:
    VN
    Mấy ngày nay trên diễn đàn có những bài viết về "Tên và nhãn", về in các trang, về tách gộp các File..., vì vậy, tôi xin giới thiệu với các bạn thêm vài chức năng sẵn có của Asap-Utilities, mà càng khám phá, tôi càng cảm thấy Add-in này hay vô cùng.
    1/ Về In : các bạn có thể sử dụng các menu sau :
    - Format / Copy a Sheet's page and print setting , với chức năng này, bạn có thể vừa chỉ định các kiểu Copy, định dạng, Title, Header and Footer, canh lề trái, phải, giữa...vừa Set up trang in
    - Sheets / Print multiple sheets : Các bạn có thể chọn những Sheet nào muốn in, chọn File muốn in, chọn máy in (trường hợp máy bạn kết nối với nhiều máy in), bạn cũng có thể biết Sheet của bạn chứa bao nhiêu trang nữa.
    -Select / Set Current Selection default to all Sheet : Bạn có thể chọn một vùng in nào đó và áp dụng vùng chọn này cho tất cả các Sheet trong Workbook
    - Về in còn có các chức năng sau : Print preview Selection, Print Selection và Sheets / Delete Print area on Selected Sheets (Xoá vùng in trên những Sheet được chọn)
    2/ Tách gộp các File : Có các Menu sau :
    - Import / Insert Excel Files : Chức năng này giúp bạn Insert tất cả các Sheet có trên một File Excel nào d0ó vào trong Workbook đang làm việc của bạn, (nghĩa là bạn vừa có thể Copy vừa Insert tất cả các Sheet từ một File khác dễ dàng và nhanh chóng)
    - Import / Insert dBase File : Giống như trên, nhưng là một File CSDL
    - Merge Files together in a new File : chức năng này kết hợp dữ liệu của tất cả các Sheet hiện có vào một Sheet duy nhất trong một Workbook mới
    3/ Chức năng Export / Export selection or active Sheet as New File sẽ giúp bạn xuất phần chọn hoặc Sheet chọn thành một File mới
    - Export / Save Selected range A Bitmap Image , và Export selected chart or range as image (file) giúp bạn lưu vùng chọn dưới dạng hình ảnh với các đuôi jpg, gif, png..., và bạn có thể chèn hình ảnh này vào bất cứ File nào khác
    4/ Menu Information / List all range name (liệt kê tên trong Workbook), List all sheet Names (Liệt kê tên các Sheet)
    - Information / Count Duplicates in Selection giúp bạn nhận biết có bao nhiêu giá trị trùng nhau trong vùng chọn, và nếu bạn cần, nó sẽ tô màu những giá trị này. Ngược lại, Count Unique Values in selection sẽ cho bạn biết những giá trị duy nhất có trong vùng chọn
    - Information / Fast and Calculation sẽ giúp bạn có ngay những giá trị Max, Min, Giá trị TB, tổng của vùng chọn, sẽ cho bạn biết có bao nhiêu Cell trống, bao nhiêu Cell có giá trị số, giá trị Text, và nếu bạn muốn, nó sẽ chép vùng bạn chọn qua một Sheet mới
    Trên đây là một số chức năng của Asap-Utilities, hy vọng công cụ này sẽ trở thành người bạn tốt nhất cho tất cả các bạn thường sử dụng Excel để tính toán
     
    #13
  14. WhoamI

    WhoamI Thành viên thân thiết

    Bài viết:
    534
    Đã được thích:
    0
    Nơi ở:
    Cố lên, cứ đi rồi sẽ tới!
    #14
  15. Anhchuot

    Anhchuot Lên thớt...

    Bài viết:
    361
    Đã được thích:
    1
    Nơi ở:
    Hanoi
    Đến giờ AC mới có được add in này, tiếc vì cập nhật muộn quá, mấy bài cơ bản chị handung107 hướng dẫn rất có ích. Cám ơn chị nhiều.
     
    #15
  16. levanduyet

    levanduyet Welcome

    Bài viết:
    535
    Đã được thích:
    11
    Giới tính:
    Nam
    Nơi ở:
    HCM
    #16
  17. handung107

    handung107 Thành viên thân thiết

    Bài viết:
    576
    Đã được thích:
    13
    Nơi ở:
    VN
    #17
  18. datartex

    datartex Thành viên hoạt động

    Bài viết:
    20
    Đã được thích:
    0
    Nơi ở:
    Hanoi
    Kính gửi chị HanhDung.

    Tôi đã download bản ASAP 3.10 và cài đặt vào máy tuy nhiên toàn bị báo lỗi không biết tại sao. Tôi đang dùng WIN98 OFFICE 2000. Mong chị chỉ dẫn giúp
     
    #18
  19. levanduyet

    levanduyet Welcome

    Bài viết:
    535
    Đã được thích:
    11
    Giới tính:
    Nam
    Nơi ở:
    HCM
    #19
  20. luonchinguoc

    luonchinguoc Thành viên sơ cấp

    Bài viết:
    6
    Đã được thích:
    0
    Nơi ở:
    Hà Nội
    #20

Chia sẻ trang này