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

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

Accommodating for Missing Parameters in Your Code

   <source lang="vb">

Function ReturnInit3(ByVal strFName As String,Optional ByVal strMI, Optional ByVal strLName)

   Dim strResult As String
   If IsMissing(strMI) And IsMissing(strLName) Then
       ReturnInit3 = strFName
   ElseIf IsMissing(strMI) Then
       ReturnInit3 = strLName & ", " & strFName
   ElseIf IsMissing(strLName) Then
       ReturnInit3 = strFName & " " & strMI
   Else
       ReturnInit3 = strLName & "," & strFName & " " & strMI
   End If

End Function Sub MissingPara()

   msgBox ReturnInit3("A", , "B")

End Sub

</source>
   
  


Default value parameters

   <source lang="vb">

Public Function Power (intNumber As Integer, Optional intPower As Variant) As Long

   If IsMissing(intPower) Then
       Power = intNumber ^ 2
   Else
       Power = intNumber ^ intPower
   End If

End Sub

Public Function Power (intNumber As Integer, Optional intPower As Integer = 2) As Long

  Power = intNumber ^ intPower

End Sub

</source>
   
  


Double type parameter

   <source lang="vb">

Sub CubeRoot(ByVal dblNumber As Double)

   dblNumber = dblNumber ^ (1 / 3)

End Sub Sub CubeRootWrapper()

   Dim dblVariable As Double
   dblVariable = 8
   Debug.Print "Before: " & dblVariable
   CubeRoot dblVariable
   Debug.Print "After: " & dblVariable

End Sub

</source>
   
  


Illustrate a reason why you might want to pass a parameter by reference

   <source lang="vb">

Sub GoodPassByRef()

   Dim blnSuccess As Boolean
   Dim strName As String
   strName = "vbex.ru"
   blnSuccess = GoodFunc(strName)
   Debug.Print blnSuccess

End Sub Function GoodFunc(strName As String)

   If Len(strName) Then
       strName = UCase$(strName)
       GoodFunc = True
   Else
       GoodFunc = False
   End If

End Function

</source>
   
  


Inserting Default Values When Parameters Are Missing

   <source lang="vb">

Function ReturnInit2(ByVal strFName As String, _

      Optional ByVal strMI, Optional ByVal strLName)
   If IsMissing(strMI) Then
       strMI = "A"
   End If
   If IsMissing(strLName) Then
       strLName = "Roman"
   End If
   ReturnInit2 = strLName & "," & strFName & " " & strMI

End Function Sub DefaultPara()

   msgBox ReturnInit2("A", , "B")

End Sub

</source>
   
  


Named parameters

   <source lang="vb">

Function fullName2(strName As String, Optional strMName As String = "vbex", Optional strLName As String)

 msgBox strName
 msgBox strMName
 msgBox strLName

End Function Sub getName2()

   Dim strFirstName As String
   Dim strLastName As String
   Dim strFullName As String
   strFirstName = "First"
   strLastName = "Last"

   msgBox fullName2(strMName:="E", strLName:="Smith", strFname:="John")
   msgBox fullName2(strFname:="John")

End Sub

</source>
   
  


Named Parameters: Eliminate the Need to Count Commas

   <source lang="vb">

Sub NamedParameter()

   msgBox ReturnInit3("Bill", , "Gates")
   msgBox ReturnInit3(strFName:="Bill", strLName:="Gates")
   msgBox ReturnInit3(strLName:="Gates", strFName:="Bill")

End Sub Function ReturnInit3(ByVal strFName As String, _

      Optional ByVal strMI, Optional ByVal strLName)
   Dim strResult As String
   If IsMissing(strMI) And IsMissing(strLName) Then
       ReturnInit3 = strFName
   ElseIf IsMissing(strMI) Then
       ReturnInit3 = strLName & ", " & strFName
   ElseIf IsMissing(strLName) Then
       ReturnInit3 = strFName & " " & strMI
   Else
       ReturnInit3 = strLName & "," & strFName & " " & strMI
   End If

End Function

</source>
   
  


Object parameter

   <source lang="vb">

Sub objvar2(w As Window)

 w.Caption = "new windows title"

End Sub

</source>
   
  


Optional Parameters: Building Flexibility into Functions

   <source lang="vb">

Function ReturnInit(ByVal strFName As String, _

      Optional ByVal strMI, Optional ByVal strLName)
   If IsMissing(strMI) Then
       strMI = InputBox("Enter Middle Initial")
   End If
   If IsMissing(strLName) Then
       strLName = InputBox("Enter Last Name")
   End If
   ReturnInit = strLName & "," & strFName & " " & strMI

End Function Sub OptionalPara()

   msgBox ReturnInit("A", , "B")

End Sub

</source>
   
  


Parameters

   <source lang="vb">

Function fullName(strFname As String, strLname As String) As String

   Dim strFirstName As String
   Dim strLastName As String
   Dim strFullName As String
   strFirstName = strFname
   strLastName = strLname
   strFullName = strFirstName & " " & strLastName
   fullName = strFullName

End Function Sub getName()

   Dim strFirstName As String
   Dim strLastName As String
   Dim strFullName As String
   strFirstName = InputBox("Enter the First Name", "First Name")
   strLastName = InputBox("Enter the Last Name", "Last Name")
   strFullName = fullName(strFirstName, strLastName)
   MsgBox strFullName, , "Full Name"

End Sub

</source>
   
  


Pass array parameter to a function

   <source lang="vb">

Function Avge(ParamArray aValues() As Variant) As Double

   Dim varValue As Variant
   Dim dblTotal As Double
   For Each varValue In aValues
       dblTotal = dblTotal + varValue
   Next
   Avge = dblTotal / (UBound(aValues) + 1)

End Function

</source>
   
  


Pass by value

   <source lang="vb">

Sub PassByVal()

   Dim strFirstName As String
   Dim strLastName As String
   strFirstName = "A"
   strLastName = "B"
   Call FuncByVal(strFirstName, strLastName)
   Debug.Print strFirstName
   Debug.Print strLastName

End Sub Sub FuncByVal(ByVal strFirstParm As String, _ ByVal strSecondParm As String)

   strFirstParm = "C"
   strSecondParm = "D"

End Sub

</source>
   
  


Passing Arrays as Parameters

   <source lang="vb">

Sub PassArray()

   "Declare a six-element array
   Dim astrNames(5) As String
   Dim intCounter As Integer
   "Call the FillNames function, passing a reference
   "to the array
   Call FillNames(astrNames)
   "Use a For...Next loop to loop through the
   "elements of the array
   For intCounter = 0 To UBound(astrNames)
       Debug.Print astrNames(intCounter)
   Next intCounter

End Sub Sub FillNames(varNameList As Variant)

   "Populate the elements of the array
   varNameList(0) = "A"
   varNameList(1) = "B"
   varNameList(2) = "C"
   varNameList(3) = "D"
   varNameList(4) = "E"
   varNameList(5) = "F"

End Sub

</source>
   
  


Passing by Reference Versus Passing by Value

   <source lang="vb">

Sub PassByRef()

   Dim strFirstName As String
   Dim strLastName As String
   strFirstName = "A"
   strLastName = "Balter"
   Call FuncByRef(strFirstName, strLastName)
   Debug.Print strFirstName
   Debug.Print strLastName

End Sub Sub FuncByRef(strFirstParm As String, strSecondParm As String)

   strFirstParm = "A"
   strSecondParm = "B"

End Sub

</source>
   
  


Pass string value through Parameters

   <source lang="vb">

Function fullName(strFname As String, strLName As String) As String

   Dim strFirstName As String
   Dim strLastName As String
   Dim strFullName As String
   strFirstName = strFname
   strLastName = strLName
   strFullName = strFirstName & " " & strLastName
   fullName = strFullName

End Function Sub getName()

   Dim strFirstName As String
   Dim strLastName As String
   Dim strFullName As String
   strFirstName = "First"
   strLastName = "Last"
   strFullName = fullName(strFirstName, strLastName)
   msgBox strFullName, , "Full Name"

End Sub

</source>
   
  


Substitute a default value if an optional parameter is not provided

   <source lang="vb">

Function fullName3(strName As String, Optional strMName As String = "vbex", Optional strLName As String)

 msgBox strName
 msgBox strMName
 msgBox strLName

End Function Sub getName3()

   Dim strFirstName As String
   Dim strLastName As String
   Dim strFullName As String
   strFirstName = "First"
   strLastName = "Last"
   strFullName = fullName3(strFirstName, , strLastName)
   msgBox strFullName, , "Full Name"

End Sub

</source>
   
  


Using the Select Case Statement to check the function parameter

   <source lang="vb">

Sub DisplayDiscount()

   Dim unitsSold As Integer
   Dim myDiscount As Single
   unitsSold = InputBox("Enter the number of sold units:")
   myDiscount = GetDiscount(unitsSold)
   MsgBox myDiscount

End Sub Function GetDiscount(unitsSold As Integer)

   Select Case unitsSold
       Case 1 To 200
           GetDiscount = 0.05
       Case 201 To 500
           GetDiscount = 0.1
       Case 501 To 1000
           GetDiscount = 0.15
       Case Is > 1000
           GetDiscount = 0.2
   End Select

End Function

</source>
   
  


Writing a Function Procedure with Arguments

   <source lang="vb">

Function JoinText(k, o)

   JoinText = k + " " + o

End Function Sub functionCall()

 MsgBox JoinText("a", "b")

End Sub

</source>