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

Материал из VB Эксперт
Версия от 12:46, 26 мая 2010; Admin (обсуждение | вклад) (1 версия)
(разн.) ← Предыдущая | Текущая версия (разн.) | Следующая → (разн.)
Перейти к: навигация, поиск

A function returns a value to whomever called it.

 
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



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

 
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



A function with one argument

 
  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)



Call user-defined function in MsgBox

 
Function CtoF(Centigrade)
   CtoF = Centigrade * 9 / 5 + 32
End Function
Sub Main()
    MsgBox CtoF(100)
End Sub



Convert Fahrenheit To Celsius

 
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



Executing a Function Procedure from a Subroutine

 
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



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

 
     Function Area(Length, Width)
         Area = Length * Width
     End Function
Sub aSub()
     MsgBox Area(100, 50)
End Sub



One of simplest possible custom functions

 
     Function GetMyFavoriteColor()
        GetMyFavoriteColor = "Magenta"
     End Function
Sub mSub()
   MsgBox GetMyFavoriteColor()
End Sub



Select Case in a function

 
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



Use ElseIf in a function

 
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



Writing VBA Function Procedures

 
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