|
|
CODE ' Code courtesy of UtterAccess Wiki ' http://www.utteraccess.com/wiki/index.php/Category:FunctionLibrary ' ' You are free to use this code in any application, ' provided this notice is left unchanged. ' ' REV DATE DESCRIPTION ' 1.0 2010-08-06 initial release ' 1.1 2010-09-12 revised function header ' '============================================================================== ' NAME: ParsePrintNumberRange ' DESC: Accepts a number range (ex. 5-9) and returns a semicolon delimited ' list of the numbers in the range (ex. 5;6;7;8;9) ' RETURNS: ZLS on error or incorrect format '============================================================================== 'ErrStrV3.00 Public Function ParsePrintNumberRange(ByVal sRange As String) As String On Error GoTo Error_Proc Dim Ret As String '========================= Dim lS As Long 'start Dim lE As Long 'end Dim lSepPos As Long 'seperator position Dim l As Long 'counter '========================= Ret = "" 'verify there's a seperator (hyphen) If InStr(1, sRange, "-") = 0 Then GoTo Exit_Proc End If 'remove spaces sRange = Replace(sRange, " ", "") 'verify there's no alpha characters For l = 1 To Len(sRange) If IsAlpha(sRange, CInt(l)) Then GoTo Exit_Proc End If Next 'get the hyphen position lSepPos = InStr(1, sRange, "-") 'get the start num lS = CLng(Left(sRange, lSepPos - 1)) 'get the end num lE = CLng(Right(sRange, Len(sRange) - lSepPos)) For l = lS To lE Ret = Ret & ";" & Trim(CStr(l)) Next If Left(Ret, 1) = ";" Then Ret = Right(Ret, Len(Ret) - 1) If Right(Ret, 1) = ";" Then Ret = Left(Ret, Len(Ret) - 1) '========================= Exit_Proc: ParsePrintNumberRange = Ret Exit Function Error_Proc: MsgBox "Error: " & Trim(Str(Err.Number)) & vbCrLf & _ "Desc: " & Err.Description & vbCrLf & vbCrLf & _ Procedure: ParsePrintNumberRange" _ , vbCritical, "Error!" Resume Exit_Proc Resume End Function
|
| This page was last modified 01:12, 5 April 2011. This page has been accessed 929 times. Disclaimers |