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

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

Accommodating for Missing Parameters in Your Code

 
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



Default value parameters

 

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



Double type parameter

 
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



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

 
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



Inserting Default Values When Parameters Are Missing

 
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



Named parameters

 
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



Named Parameters: Eliminate the Need to Count Commas

 
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



Object parameter

 
Sub objvar2(w As Window)
  w.Caption = "new windows title"
End Sub



Optional Parameters: Building Flexibility into Functions

 
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



Parameters

 
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



Pass array parameter to a function

 
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



Pass by value

 
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



Passing Arrays as Parameters

 
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



Passing by Reference Versus Passing by Value

 
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



Pass string value through Parameters

 
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



Substitute a default value if an optional parameter is not provided

 
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



Using the Select Case Statement to check the function parameter

 
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



Writing a Function Procedure with Arguments

 
Function JoinText(k, o)
    JoinText = k + " " + o
End Function
Sub functionCall()
  MsgBox JoinText("a", "b")
End Sub