Running a function with a macro

Collapse
X
 
  • Time
  • Show
Clear All
new posts
  • williamvarah
    New Member
    • Oct 2006
    • 2

    #1

    Running a function with a macro

    I want to be able to link a macro to an icon in excel so that I can run a function that I have in excel visual basic. I'm trying to use runcode to do this but it's not working. The code for the function is as follows:

    Function ConvertCurrency ToUK(ByVal MyNumber)
    Dim Temp
    Dim Pounds, Pence
    Dim DecimalPlace, count

    ReDim Place(9) As String
    Place(2) = " Thousand "
    Place(3) = " Million "
    Place(4) = " Billion "
    Place(5) = " Trillion "

    ' Convert MyNumber to a string, trimming extra spaces.
    MyNumber = Trim(Str(MyNumb er))

    ' Find decimal place.
    DecimalPlace = InStr(MyNumber, ".")

    ' If we find decimal place...
    If DecimalPlace > 0 Then
    ' Convert pence
    Temp = Left(Mid(MyNumb er, DecimalPlace + 1) & "00", 2)
    Pence = ConvertTens(Tem p)

    ' Strip off pence from remainder to convert.
    MyNumber = Trim(Left(MyNum ber, DecimalPlace - 1))
    End If

    count = 1
    Do While MyNumber <> ""
    ' Convert last 3 digits of MyNumber to English pounds.
    Temp = ConvertHundreds (Right(MyNumber , 3))
    If Temp <> "" Then Pounds = Temp & Place(count) & Pounds
    If Len(MyNumber) > 3 Then
    ' Remove last 3 converted digits from MyNumber.
    MyNumber = Left(MyNumber, Len(MyNumber) - 3)
    Else
    MyNumber = ""
    End If
    count = count + 1
    Loop

    ' Clean up pounds.
    Select Case Pounds
    Case ""
    Pounds = "No Pounds"
    Case "One"
    Pounds = "One Pound"
    Case Else
    Pounds = Pounds & " Pounds"
    End Select

    ' Clean up Pence.
    Select Case Pence
    Case ""
    Pence = " and No Pence"
    Case "One"
    Pence = " and One Penny"
    Case Else
    Pence = " and " & Pence & " Pence"
    End Select

    ConvertCurrency ToUK = Pounds & Pence
    End Function



    Private Function ConvertHundreds (ByVal MyNumber)
    Dim Result As String

    ' Exit if there is nothing to convert.
    If Val(MyNumber) = 0 Then Exit Function

    ' Append leading zeros to number.
    MyNumber = Right("000" & MyNumber, 3)

    ' Do we have a hundreds place digit to convert?
    If Left(MyNumber, 1) <> "0" Then
    Result = ConvertDigit(Le ft(MyNumber, 1)) & " Hundred "
    End If

    ' Do we have a tens place digit to convert?
    If Mid(MyNumber, 2, 1) <> "0" Then
    Result = Result & ConvertTens(Mid (MyNumber, 2))
    Else
    ' If not, then convert the ones place digit.
    Result = Result & ConvertDigit(Mi d(MyNumber, 3))
    End If

    ConvertHundreds = Trim(Result)
    End Function



    Private Function ConvertTens(ByV al MyTens)
    Dim Result As String

    ' Is value between 10 and 19?
    If Val(Left(MyTens , 1)) = 1 Then
    Select Case Val(MyTens)
    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
    ' .. otherwise it's between 20 and 99.
    Select Case Val(Left(MyTens , 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

    ' Convert ones place digit.
    Result = Result & ConvertDigit(Ri ght(MyTens, 1))
    End If

    ConvertTens = Result
    End Function



    Private Function ConvertDigit(By Val MyDigit)
    Select Case Val(MyDigit)
    Case 1: ConvertDigit = "One"
    Case 2: ConvertDigit = "Two"
    Case 3: ConvertDigit = "Three"
    Case 4: ConvertDigit = "Four"
    Case 5: ConvertDigit = "Five"
    Case 6: ConvertDigit = "Six"
    Case 7: ConvertDigit = "Seven"
    Case 8: ConvertDigit = "Eight"
    Case 9: ConvertDigit = "Nine"
    Case Else: ConvertDigit = ""
    End Select
    End Function



    OK - so it works when I run it directly from the function list. How can I get this to run as a macro? I'm a complete novice when it comes to programming so you'll have to speak in words of one syllable so to speak!
  • albertw
    Contributor
    • Oct 2006
    • 267

    #2
    Originally posted by williamvarah
    I want to be able to link a macro to an icon in excel so that I can run a function that I have in excel visual basic. I'm trying to use runcode to do this but it's not working. The code for the function is as follows:

    Function ConvertCurrency ToUK(ByVal MyNumber)
    Dim Temp
    Dim Pounds, Pence
    Dim DecimalPlace, count

    ReDim Place(9) As String
    Place(2) = " Thousand "
    Place(3) = " Million "
    Place(4) = " Billion "
    Place(5) = " Trillion "

    ' Convert MyNumber to a string, trimming extra spaces.
    MyNumber = Trim(Str(MyNumb er))

    ' Find decimal place.
    DecimalPlace = InStr(MyNumber, ".")

    ' If we find decimal place...
    If DecimalPlace > 0 Then
    ' Convert pence
    Temp = Left(Mid(MyNumb er, DecimalPlace + 1) & "00", 2)
    Pence = ConvertTens(Tem p)

    ' Strip off pence from remainder to convert.
    MyNumber = Trim(Left(MyNum ber, DecimalPlace - 1))
    End If

    count = 1
    Do While MyNumber <> ""
    ' Convert last 3 digits of MyNumber to English pounds.
    Temp = ConvertHundreds (Right(MyNumber , 3))
    If Temp <> "" Then Pounds = Temp & Place(count) & Pounds
    If Len(MyNumber) > 3 Then
    ' Remove last 3 converted digits from MyNumber.
    MyNumber = Left(MyNumber, Len(MyNumber) - 3)
    Else
    MyNumber = ""
    End If
    count = count + 1
    Loop

    ' Clean up pounds.
    Select Case Pounds
    Case ""
    Pounds = "No Pounds"
    Case "One"
    Pounds = "One Pound"
    Case Else
    Pounds = Pounds & " Pounds"
    End Select

    ' Clean up Pence.
    Select Case Pence
    Case ""
    Pence = " and No Pence"
    Case "One"
    Pence = " and One Penny"
    Case Else
    Pence = " and " & Pence & " Pence"
    End Select

    ConvertCurrency ToUK = Pounds & Pence
    End Function



    Private Function ConvertHundreds (ByVal MyNumber)
    Dim Result As String

    ' Exit if there is nothing to convert.
    If Val(MyNumber) = 0 Then Exit Function

    ' Append leading zeros to number.
    MyNumber = Right("000" & MyNumber, 3)

    ' Do we have a hundreds place digit to convert?
    If Left(MyNumber, 1) <> "0" Then
    Result = ConvertDigit(Le ft(MyNumber, 1)) & " Hundred "
    End If

    ' Do we have a tens place digit to convert?
    If Mid(MyNumber, 2, 1) <> "0" Then
    Result = Result & ConvertTens(Mid (MyNumber, 2))
    Else
    ' If not, then convert the ones place digit.
    Result = Result & ConvertDigit(Mi d(MyNumber, 3))
    End If

    ConvertHundreds = Trim(Result)
    End Function



    Private Function ConvertTens(ByV al MyTens)
    Dim Result As String

    ' Is value between 10 and 19?
    If Val(Left(MyTens , 1)) = 1 Then
    Select Case Val(MyTens)
    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
    ' .. otherwise it's between 20 and 99.
    Select Case Val(Left(MyTens , 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

    ' Convert ones place digit.
    Result = Result & ConvertDigit(Ri ght(MyTens, 1))
    End If

    ConvertTens = Result
    End Function



    Private Function ConvertDigit(By Val MyDigit)
    Select Case Val(MyDigit)
    Case 1: ConvertDigit = "One"
    Case 2: ConvertDigit = "Two"
    Case 3: ConvertDigit = "Three"
    Case 4: ConvertDigit = "Four"
    Case 5: ConvertDigit = "Five"
    Case 6: ConvertDigit = "Six"
    Case 7: ConvertDigit = "Seven"
    Case 8: ConvertDigit = "Eight"
    Case 9: ConvertDigit = "Nine"
    Case Else: ConvertDigit = ""
    End Select
    End Function



    OK - so it works when I run it directly from the function list. How can I get this to run as a macro? I'm a complete novice when it comes to programming so you'll have to speak in words of one syllable so to speak!
    hi
    usually functions and/or subs will not start all by themselves and also in Exel, not by filling a cell.
    So you need to create a button (right mousebutton over the menubar and select ' visual basic ')

    from the next screen, select toolbox and designmode
    then draw a button somewhere, give it a name like ' cmdConvert'
    even may suppress the button getting printed... etc
    after that doubleclick the button (still in designmode) to enter the code
    have your function started from inside the created Private Sub

    Comment

    Working...