In this document:
Function Proper (var as Variant)
Function ConvertTo2Digits(str
As String) As String
Public Function Pad(str As
Variant, lngLength As Long) As String
Function RU(strIn As String)
As String
Function Work_Days(BegDate As Variant, EndDate
As Variant) As Integer
Sub WriteOutNumberedFile(strFileName
As String)
'
------------------------------------------------
' Use this function to correct case for proper nouns.
' For example if company
names have been entered in all upper case, create an Update Query that calls this
function toc orrect it.
' ------------------------------------------------
Function
Proper(var As Variant) As Variant
' Purpose: Convert the case of var so that the first letter of each word capitalized.
Dim strV As String, intChar
As Integer, i As Integer
Dim fWasSpace As Integer
'Flag: was previous char a space?
If IsNull(var) Then Exit Function
strV =
var
fWasSpace = True 'Initialize to capitalize first letter.
For i = 1 To Len(strV)
intChar =
Asc(Mid$(strV, i,
1))
Select Case intChar
Case 65 To 90 ' A to Z
If Not fWasSpace Then Mid$(strV,
i, 1) = Chr$(intChar
Or &H20)
Case 97 To 122 ' a to z
If fWasSpace Then Mid$(strV,
i, 1) = Chr$(intChar
And &HDF)
End Select
fWasSpace = (intChar = 32)
Next
Proper = strV
End Function
' ========================================================================
' Now we can't have our customers
look at $23.123 or $23.1 now can we?!
' ========================================================================
Function
ConvertTo2Digits(str As String) As String
Dim pos As Long
' Find the decimal place.
pos = InStr(1, str, ".")
' If there isn't a decimal place, add the two zeros
and get out of this function
If pos = 0 Then
ConvertTo2Digits = str
& ".00"
Else
' Check if there are two digits after the decimal
If Len(str) - pos = 2
Then
ConvertTo2Digits = str
Else
If Len(str) - pos = 1
Then
ConvertTo2Digits = str
& "0"
Else
' Find if there is a 5 in the 3rd position, update
b/c Round() can't f*cking handle it still
pos = InStr(1, str, ".")
If Mid(str, pos + 3, 1)
>= "5" Then
' Are digits after the decimal point zero?
If Mid(str, pos + 1, 2)
= "00" Then
' Check the 3rd digit over, just in case we still
need to add 1
If Mid(str, pos + 3, 1)
>= 5 Then
str = Mid(str,
1, pos) & "01"
Else
str = Mid(str,
1, pos) & (Mid(str, pos + 1, 2) + 1)
End If
Else
' Often when doing the adding, the 0 gets chopped
off.
' It often looks like the digits switched to users.
If Mid(str, pos + 1, 1)
= "0" Then
str = Mid(str,
1, pos) & "0" & (Mid(str, pos + 1,
2) + 1)
Else
' If the digits after the decimal point are 99, followed
by a # higher than 5 -
' increment the whole thing
If Mid(str, pos + 1, 2)
= "99" Then
str = Mid(str,
1, pos - 1) + 1 & ".00"
Else
' If the digits after the decimal point can safely
be rounded, do it.
str = Mid(str,
1, pos) & (Mid(str, pos + 1, 2) + 1)
End If
End If
End If
End If
' Since round only removes digits after the decimal
place,
' we couldn't
have just run this in the beginning.
str = Round(str,
2)
If InStr(1,
str, ".") = 0 Then str = str & ".00"
If Len(str) - InStr(1, str, ".") =
1 Then str =
str & "0"
ConvertTo2Digits = str
End If
End If
End If
End Function
' ----------------------------------------------------------------
' Since
' I have to pad my data when interacting w/
' my searches return no results.
' ----------------------------------------------------------------
Public Function Pad(str As Variant,
lngLength As Long) As String
' Obviously, we can't do nulls
If IsNull(str) = True Then Exit Function
' and we can't do it if the requested length is more
than the string
Dim i As Long
i = lngLength - Len(str)
If i < 0 Then Exit Function
' Add the ' ' to the string.
For i = 1 To (lngLength
- Len(str))
str =
str & " "
Next
Pad = str
End Function
' ============================================================
' This removes the underscore from
a string.
' ============================================================
Function
RU(strIn As String) As String
Dim intI As Integer
Dim intPos As Integer
Dim strChar As String * 1
Dim strOut As String
Dim intMode As Integer
Dim strMapOut As String
Dim strMapIn As String
strMapIn = "_"
If Len(strMapIn) >
0 Then
' Right-Fill the strMapOutset..
If Len(strMapOut) >
0 Then
strMapOut = Left(strMapOut & String(Len(strMapIn),
Right(strMapOut, 1)), Len(strMapIn))
End If
For intI = 1 To Len(strIn)
strChar = Mid$(strIn, intI, 1)
intPos =
InStr(1, strMapIn, strChar,
vbTextCompare)
If intPos > 0 Then
strOut = strOut & Mid$(strMapOut,
intPos, 1)
Else
strOut =
strOut & strChar
End If
Next intI
End If
RU = strOut
End Function
Function
Work_Days(BegDate
As Variant, EndDate As Variant) As Integer
' Note that this function does not account for holidays.
Dim WholeWeeks As Variant
Dim DateCnt As Variant
Dim EndDays As Integer
BegDate =
DateValue(BegDate)
EndDate =
DateValue(EndDate)
WholeWeeks =
DateDiff("w",
BegDate, EndDate)
DateCnt =
DateAdd("ww",
WholeWeeks, BegDate)
EndDays = 0
Do While DateCnt < EndDate
If Format(DateCnt, "ddd") <> "Sun" And _
Format(DateCnt, "ddd") <> "Sat" Then
EndDays = EndDays + 1
End If
DateCnt =
DateAdd("d", 1,
DateCnt)
Work_Days = WholeWeeks
* 5 + EndDays
End Function
' =========================================================
' It can often be difficult to
figure out QBs #ing scheme.
' This writes a
seperate file for the #'ed version.
' =========================================================
Sub
WriteOutNumberedFile(strFileName As String)
Dim str As String, i As Long
str =
VBA.Mid(strFileName, 1, Len(strFileName)
- 4) & " with Line Numbers.txt"
i = 1
Close
Open strFileName For Input As #1
Open str For Output As
#2
While EOF(1) = False
Line Input #1, str
Print #2, i & ". "
& str
i = i + 1
Wend
Close
End Sub