VBA/Excel/Access/Word/Language Basics/Function

Материал из VB Эксперт
Перейти к: навигация, поиск

A function returns a value to whomever called it.

   <source lang="vb">

Sub useaFunction()

  MsgBox concatF()

End Sub Function concatF() As String

   Dim strFirstname As String
   Dim strLastName As String
   Dim strFullName As String
   strFirstname = "John"
   strLastName = "Smith"
   strFullName = strFirstname & " " & strLastName
   concatF = strFullName

End Function

</source>
   
  


A function returns a value to whomever called it. We can recast the previous sub into a function as follows:

   <source lang="vb">

Function concat() As String

   Dim strFirstname As String
   Dim strLastName As String
   Dim strFullName As String
   strFirstname = "John"
   strLastName = "Smith"
   strFullName = strFirstname & " " & strLastName
   concat = strFullName

End Function

</source>
   
  


A function with one argument

   <source lang="vb">

 Function Commission(Sales)
 "   Calculates sales commissions
     Dim Tier1 As Double, Tier2 As Double
     Dim Tier3 As Double, Tier4 As Double
     Tier1 = 0.08
     Tier2 = 0.105
     Tier3 = 0.12
     Tier4 = 0.14
     Select Case Sales
         Case 0 To 9999.99: Commission = Sales * Tier1
         Case 10000 To 19999.99: Commission = Sales * Tier2
         Case 20000 To 39999.99: Commission = Sales * Tier3
         Case Is >= 40000: Commission = Sales * Tier4
     End Select
     Commission = Round(Commission, 2)
 End Function
 =Commission(25000)
</source>
   
  


Call user-defined function in MsgBox

   <source lang="vb">

Function CtoF(Centigrade)

  CtoF = Centigrade * 9 / 5 + 32

End Function Sub Main()

   MsgBox CtoF(100)

End Sub

</source>
   
  


Convert Fahrenheit To Celsius

   <source lang="vb">

Private Sub TestFahrenheitToCelsius()

 Debug.Print FahrenheitToCelsius(32)
 If (FahrenheitToCelsius(32) <> 0) Then
   Debug.Print "TestFahrenheitToCelsius: Failed"
   Debug.Assert False
 Else
   Debug.Print "TestFahrenheitToCelsius: Passed"
 End If

End Sub Public Function FahrenheitToCelsius(ByVal TemperatureFahrenheit As Double) As Double

 FahrenheitToCelsius = (5 / 9 * (TemperatureFahrenheit - 32))

End Function

</source>
   
  


Executing a Function Procedure from a Subroutine

   <source lang="vb">

Sub EnterText()

   Dim strFirst As String, strLast As String, strFull As String
   strFirst = InputBox("Enter your first name:")
   strLast = InputBox("Enter your last name:")
   strFull = JoinText(strFirst, strLast)
   
   MsgBox strFull

End Sub Function JoinText(k, o)

   JoinText = k + " " + o

End Function

</source>
   
  


function takes two arguments"s length and width"s and calculates the total area by multiplying them together

   <source lang="vb">

    Function Area(Length, Width)
        Area = Length * Width
    End Function

Sub aSub()

    MsgBox Area(100, 50)

End Sub

</source>
   
  


One of simplest possible custom functions

   <source lang="vb">

    Function GetMyFavoriteColor()
       GetMyFavoriteColor = "Magenta"
    End Function

Sub mSub()

  MsgBox GetMyFavoriteColor()

End Sub

</source>
   
  


Select Case in a function

   <source lang="vb">

Public Function AssignGrade(studScore As Single) As String

   Select Case studScore
       Case 90 To 100
           AssignGrade = "A"
       Case 80 To 89
           AssignGrade = "B"
       Case 70 To 79
           AssignGrade = "C"
       Case Else
           AssignGrade = "F"
   End Select

End Function

</source>
   
  


Use ElseIf in a function

   <source lang="vb">

Public Function LoanCriteria(loanAmt As Single, numPayments As Integer, _

        moPayment As Integer, totInterest As Single) As Boolean
   If Abs(moPayment) > 400 Then
       LoanCriteria = False
   ElseIf Abs(totInterest) > (0.1 * loanAmt) Then
        LoanCriteria = False
   ElseIf numPayments > 48 Then
       LoanCriteria = False
   Else
       LoanCriteria = True
   End If

End Function

</source>
   
  


Writing VBA Function Procedures

   <source lang="vb">

Private Sub Main2()

   Dim num1 As Double
   Dim myRoot As Double
   num1 = 10
   myRoot = SqRoot(num1)
   myRoot = Format(myRoot, "#0.00")
   MsgBox "The square root of " & num1 & "is " & myRoot

End Sub Public Function SqRoot(ByVal num1 As Double) As Double

   num1 = Sqr(num1)
   SqRoot = num1

End Function

</source>