White Tigers
The white tiger (also known as the Bengal tiger) is about 3 meters long, and weighs approximately 180-285 kg (400-569 lbs). It’s coat lies flatter than that of the Siberian tiger, the tawny color is richer and the stripes are darker.
White tigers are white colored bengals, they are not albinos and they are not a seperate subspecies of tigers.
They have blue eyes, a pink nose, and creamy white fur covered with chocolate colored stripes. White tigers are born to tigers that carry the unusual gene needed for white coloring. Wild white tigers are very rare.
They are usually located on the Mainland of Southeastern Asia and in central and southern India. The white Bengal tiger lives in grassy or swampy areas and forests, where they can be well camouflaged. Those living on islands have almost disappeared; most now live in zoo’s or special wildlife parks.

Code Samples
NOTE:
Code presented in the code panes below may line wrap. If you can stretch your browser's width then they may unwrap. Just beware of the line wrap issue.
Code To HTML Convertor
Convert HTML/XML or VBA code to viewable HTML by copying your HTML/XML or VBA code into this page and pressing the appropriate button. Your code will be converted on-line to nicely formatted HTML using the <code> tag and some <span> elements. Extremely useful (used here - check out the code boxs below.). VBA code will display with the syntax coloring used by Access!
Updated 2009-02-14.
Rich Text Textboxes
Just a quick note for those of you wrestling with Rich Text flavor of the textbox control. I knew it was based on HTML rather than the Microsoft Rich Text Format (RTF) used by Word. Despite its name it doesn't support RTF codes and it only supports a limited set of HTML tags, some that have been deprecated for awhile. I wasn't able to find this info in the on-line help or in MSDN. Instead I happened across a MS blog that provided the most guidance I've found anywhere on line.
Here, in short format, are the supported HTML tags:
<font face="Arial Black" size=3 color="#A5A5A5" style="BACKGROUND-COLOR:#FFFF00">
<strong>
<em>
<u>
<br>
<div align=right dir=RTL>
<blockquote>
<ol> and <li> for number
<ul> and <li> for bulleted lists
Updated 2009-02-28.
Metamorphosis
The goal behind Metamorphosis is to provide sample code that can be used to migrate older Access data (i.e. Back-End data) into the running Access app's back-end and to handle the conversion process to the different format (new fields, dropped fields, type conversions, etc.). Metamorphosis won't create tables or relationships. Metamorphosis is a class module that you call from code in a module, form, menu or coded to run automagically.
This isn't a cut-and-paste solution for a new user. To use Metamorphosis will require some time reviewing to understand if it can meet your needs. Here is sample code on how to use Metamorphosis:
Public Sub Migrate()
Dim cMigrateData As New clsMetamorphosis
With cMigrateData
.PromptForXmlFile = True
.Migrate
End With
Set cMigrateData = Nothing
End Sub
'
' Writes a nicely formatted listing of the source and destination mappings.
'
Public Sub ListMappings()
Dim cMigrateData As New clsMetamorphosis
With cMigrateData
.PromptForXmlFile = True
.ListMappings
End With
Set cMigrateData = Nothing
End Sub
The first generation defined table/field mappings in the code. This could be done because everyone used the same dataabase schema. If you are migrating users from one version to a new updated version then mapping via code statements may be the desired method. No additional files - just download a new Front-End with the Metamorphosis code. Here is how the mapping looks in the code:
mapTable.sOrigTable = "TypicalMaterials"
mapTable.sNewTable = "Materials"
' map fields -------------------------
nFieldsMapped = 0
With mapField
.sOrigField = "LITERAL=Typical"
.nOrigFieldDataType = dbText
.sNewField = "Category"
.nNewFieldDataType = dbText
.bKeyField = False
End With
ReDim Preserve arrFields(nFieldsMapped)
arrFields(nFieldsMapped) = mapField
nFieldsMapped = nFieldsMapped + 1
With mapField
.sOrigField = "MaterialCode"
.nOrigFieldDataType = dbText
.sNewField = "ItemID"
.nNewFieldDataType = dbText
.bKeyField = True
End With
ReDim Preserve arrFields(nFieldsMapped)
arrFields(nFieldsMapped) = mapField
nFieldsMapped = nFieldsMapped + 1
With mapField
.sOrigField = "MaterialType"
.nOrigFieldDataType = dbText
.sNewField = "Description"
.nNewFieldDataType = dbText
.bKeyField = True
End With
ReDim Preserve arrFields(nFieldsMapped)
arrFields(nFieldsMapped) = mapField
nFieldsMapped = nFieldsMapped + 1
With mapField
.sOrigField = "CostPerSqFt"
.nOrigFieldDataType = dbCurrency
.sNewField = "UnitPrice"
.nNewFieldDataType = dbCurrency
.bKeyField = False
End With
ReDim Preserve arrFields(nFieldsMapped)
arrFields(nFieldsMapped) = mapField
nFieldsMapped = nFieldsMapped + 1
' save mappings -------------------------
mapTable.arrMap = arrFields
ReDim Preserve arrTables(nTablesMapped)
arrTables(nTablesMapped) = mapTable
nTablesMapped = nTablesMapped + 1
Gets more difficult if there are multiple database schemas in use in the Back-End for different clients. Metamorphosis now supports the use of XML mapping files where the table and field mapping can be defined by XML. Just deliver a custom made XML file to the client which defines their unique data conversion needs. The code can prompt the user for the XML file location or you can hard-code it into the sample and away you go. Here is how it would look in XML:
<?xml version="1.0" encoding="utf-8"?>
<dataMapping>
<tableset>
<tables>
<OrigTable>TypicalMaterials</OrigTable>
<NewTable>Materials</NewTable>
</tables>
<fieldMap>
<field>
<OrigField>LITERAL=Typical</OrigField>
<OrigFieldDataType>10</OrigFieldDataType>
<NewField>Category</NewField>
<NewFieldDataType>10</NewFieldDataType>
<KeyField>False</KeyField>
</field>
<field>
<OrigField>MaterialCode</OrigField>
<OrigFieldDataType>10</OrigFieldDataType>
<NewField>ItemID</NewField>
<NewFieldDataType>10</NewFieldDataType>
<KeyField>True</KeyField>
</field>
<field>
<OrigField>MaterialType</OrigField>
<OrigFieldDataType>10</OrigFieldDataType>
<NewField>Description</NewField>
<NewFieldDataType>10</NewFieldDataType>
<KeyField>False</KeyField>
</field>
<field>
<OrigField>CostPerSqFt</OrigField>
<OrigFieldDataType>5</OrigFieldDataType>
<NewField>UnitPrice</NewField>
<NewFieldDataType>5</NewFieldDataType>
<KeyField>False</KeyField>
</field>
</fieldMap>
</tableset>
</dataMapping>
It doesn't make sense to go over all the code here. Hopefully I've shown enough for you to decide if it is worth checking out the download.
Updated 2009-02-28.
Centering a Form
Access forms can be centered by setting the form's AutoCenter property to True. But a recent project I did required me to cascade a set of windows for the user. After the user inspects and closes the windows the original form was left positioned in the upper left corner. This wasn't acceptable, that form had to be re-centered.
The form's Activate event was the appropriate event to use for re-positioning the form. I used the code below to re-center the form. Here is how it works:
First I display the hourglass icon and turn off screen updates. I then maximize the form within the Access window and save the inside dimensions - this gives me the size of the Access window.
After restoring the form to its original size I use the size of the window that the form is enclosed in to do the math necessary to center the window.
I wanted to generalize the code so that it could be used for any window and the code below does that by accepting a reference to the form. However this is a potential "gotcha" in this code that you should be aware of. The DoCmd statement in the code operates on whatever object currently has the focus. This might not be the object you expect!
Some DoCmd methods let you specify the object like the DoCmd.Close method. You can close a form with code like this:
Private Sub cmdClose_Click()
DoCmd.Close acForm, Me.Name, acSaveNo
End Sub
This line of code is very specific about what is to be closed. But the DoCmd methods I use in this code sample (.Maximize, .Restore, .MoveSize) don't allow you to specify the object. Instead it applies to whatever object currently has the focus. If a user should click on another object (perhaps another form or a report that is open) then the focus has shifted and the command will be applied to that object.
I minimize the chances of this happening by explicitly setting the focus in the previous line of code to the object I want to operate on. Doesn't eliminate the risk but does reduce it. If you are uncomfortable with this risk you can move the code directly to the Form's Activate event but you'll have to duplicate the code for each form you intend to center.
To center a form just call the proc from the form's Activate event:
Private Sub Form_Activate()
CenterForm Me
End Sub
Here is the code that should be put into a Module:
Option Compare Database
Option Explicit
Private m_bNotFirstUse As Boolean
'
Public Sub CenterForm(objForm As Access.Form)
On Error GoTo errHandler
If m_bNotFirstUse = False Then
m_bNotFirstUse = True
Exit Sub
End If
Dim nScreenWidth As Long, nScreenHeight As Long, nFormHeight As Long
' show the user the wait cursor
DoCmd.Hourglass True
Application.Echo False
' save the form's window height
nFormHeight = objForm.WindowHeight
' try to ensure this object has the focus prior to running a general cmd
objForm.SetFocus
' maximize this form to the full size of the Access window
DoCmd.Maximize
DoEvents
' get the current size of the form so we can determine the size
' of the Access window
nScreenHeight = objForm.InsideHeight
nScreenWidth = objForm.InsideWidth
'Debug.Print "InsideHeight = " & objForm.InsideHeight & _
" and InsideWidth = " & objForm.InsideWidth
' try to ensure this object has the focus prior to running a general cmd
objForm.SetFocus
DoCmd.Restore ' restore the form to its original height and width
' there is enough info to center the form
' try to ensure this object has the focus prior to running a general cmd
objForm.SetFocus
DoCmd.MoveSize (nScreenWidth - objForm.WindowWidth) \ 2 _
, (nScreenHeight - objForm.WindowHeight) \ 2
exitHandler:
Application.Echo True ' allow user to see this form
DoCmd.Hourglass False
Exit Sub
errHandler:
' make sure we turn screen updates back on
Resume exitHandler
End Sub
Just a note that I prevent the initial form from centering. I use a startup form in this project and it would not center correctly on startup. Most likely the Access window is not properly setup yet and so the window sizes are "off" resulting in my startup form being off-center. I used a basic flag (or semaphore) technique to prevent the centering code from working for the first form opened. An enhancement that could be made would be to check if a startup form is specified and use that value to alter this behavior.
Updated 2009-02-27.
Ensuring Line Numbers Have Been Added to Appropriate Code
Do you use the Erl() function as part of your logging or error message? Line numbers can make hunting down errors much easier and there are several utilities out there than can add/remove line numbers with the click of an icon (a popular one is MZ-Tools).
Here is a proc that will search your form, report and module code looking for procs where the Erl() call is used and list any of those procs that are missing line numbers.
This is one of the build steps I use prior to delivery of beta code to the client. Add this code to a module (perhaps a module that you'll ultimately delete prior to final delivery) and then call it from the Immediate Window (Ctrl-G) by typing: listProcsWithoutLineNumbers
'
' Quick way to check if I have used the Erl() function in code that doesn't have line numbers.
'
Public Sub listProcsWithoutLineNumbers()
10 On Error GoTo errHandler
Dim modl As Module, frm As Form, rpt As Report
Dim dbs As DAO.Database, curDoc As DAO.Document
Dim nActualLineNumber As Long
Dim strProcName As String, nProcType As Long
Dim strCodeLineText As String
Dim sFirstChar As String
Dim bContinuationOfPreviousLine As Boolean
Dim bFoundProcWithoutLineNumbers As Boolean
20 Set dbs = CurrentDb
30 DoCmd.Hourglass True
40 Application.Echo False
50 LogMessage "-----------------------------------------------------------------------"
60 For Each curDoc In dbs.Containers("Modules").Documents
70 DoCmd.OpenModule curDoc.Name
80 Set modl = Modules(curDoc.Name)
90 For nActualLineNumber = 1 To modl.CountOfLines
100 strCodeLineText = Trim(modl.Lines(nActualLineNumber, 1))
110 If Not bContinuationOfPreviousLine Then
120 sFirstChar = Left$(strCodeLineText, 1)
130 End If
140 If InStr(1, strCodeLineText, "Erl()", vbTextCompare) > 0 Then
150 If sFirstChar <> "'" Then
160 If Not IsNumeric(sFirstChar) Then
170 strProcName = modl.ProcOfLine(nActualLineNumber, nProcType)
180 LogMessage modl.Name & " - " & strProcName _
& "() at actual line " & nActualLineNumber
190 bFoundProcWithoutLineNumbers = True
200 End If
210 End If
220 End If
230 bContinuationOfPreviousLine = (Right$(strCodeLineText, 1) = "_")
240 Next nActualLineNumber
250 DoCmd.Close acModule, curDoc.Name, acSaveNo
260 Next curDoc
270 bContinuationOfPreviousLine = False
280 For Each curDoc In dbs.Containers("Forms").Documents
290 DoCmd.OpenForm curDoc.Name, acDesign, , , , acHidden
300 Set frm = Forms(curDoc.Name)
310 For nActualLineNumber = 1 To frm.Module.CountOfLines
320 strCodeLineText = Trim(frm.Module.Lines(nActualLineNumber, 1))
330 If bContinuationOfPreviousLine = False Then
340 sFirstChar = Left$(strCodeLineText, 1)
350 End If
360 If InStr(1, strCodeLineText, "Erl()", vbTextCompare) > 0 Then
370 If sFirstChar <> "'" Then
380 If Not IsNumeric(sFirstChar) Then
390 strProcName = frm.Module.ProcOfLine(nActualLineNumber, nProcType)
400 LogMessage frm.Name & " - " & strProcName _
& "() at actual line " & nActualLineNumber
410 bFoundProcWithoutLineNumbers = True
420 End If
430 End If
440 End If
450 bContinuationOfPreviousLine = (Right$(Trim(strCodeLineText), 1) = "_")
460 Next nActualLineNumber
470 DoCmd.Close acForm, curDoc.Name, acSaveNo
480 Next curDoc
490 bContinuationOfPreviousLine = False
500 For Each curDoc In dbs.Containers("Reports").Documents
510 DoCmd.OpenReport curDoc.Name, acDesign
520 Set rpt = Reports(curDoc.Name)
530 For nActualLineNumber = 1 To rpt.Module.CountOfLines
540 strCodeLineText = Trim(rpt.Module.Lines(nActualLineNumber, 1))
550 If Not bContinuationOfPreviousLine Then
560 sFirstChar = Left$(strCodeLineText, 1)
570 End If
580 If InStr(1, strCodeLineText, "Erl()", vbTextCompare) > 0 Then
590 If sFirstChar <> "'" Then
600 If Not IsNumeric(sFirstChar) Then
610 strProcName = rpt.Module.ProcOfLine(nActualLineNumber, nProcType)
620 LogMessage rpt.Name & " - " & strProcName _
& "() at actual line " & nActualLineNumber
630 bFoundProcWithoutLineNumbers = True
640 End If
650 End If
660 End If
670 bContinuationOfPreviousLine = (Right$(strCodeLineText, 1) = "_")
680 Next nActualLineNumber
690 DoCmd.Close acReport, curDoc.Name, acSaveNo
700 Next curDoc
exitHandler:
710 If Not (dbs Is Nothing) Then Set dbs = Nothing
720 DoCmd.Hourglass False
730 Application.Echo True
740 If bFoundProcWithoutLineNumbers = False Then
750 LogMessage "Did not find any procs that were missing line numbers."
760 End If
770 LogMessage "------------------------------ Finished. ------------------------------"
780 Exit Sub
errHandler:
Dim nErr As Long
790 nErr = Err.Number
' ignore error 17:
' error in <module name> at line xxx: Can't perform requested operation (17)
' log it and resume next
' this occurs while trying to close a module previously opened with
' DoCmd.OpenModule. Researching...
'
' MS says:
' The requested operation can't be performed because it would invalidate the
' current state of the project. For example, the error occurs if you use the
' References dialog box (on the Tools menu, click Rererences) to add a
' reference to a new project or object library while a program is in break mode.
'
800 If nErr = 17 Then
'LogMessage "Error 17: " & curDoc.Name & ":" & strProcName _
' & " at line " & Erl() & ": " & Err.Description
810 Resume Next
820 Else
830 LogMessage "listProcsWithoutLineNumbers() error in " & curDoc.Name & ":" _
& strProcName & " at line " & Erl() _
& ": " & Err.Description & " (" & Err.Number & ")"
840 End If
850 Resume exitHandler
End Sub
Just to be complete I have added my log module code. You might your own preferred method but if not this might be a good starting point for your app.
The Log Module code lets me log messages by writing a line of code:
LogMessage "Write this to the log."
After setting up the log destination with a line of code in my startup procedure:
SetErrorLogging True, eMsgBox
The log module can write to the Immediate Window (eDebug), display in a MsgBox (eMsgBox), write to a text file (eFile) or to a table (eTable).
Option Compare Database
Option Explicit
'
' This is error logging code. Using this code you can easily change where log messages
' are displayed or saved with a line of code:
'
' SetErrorLogging True, eMsgBox
'
' SetErrorLogging True, eFile
'
' in your startup code. You can set the log file name (if the default "AppLog.txt"
' doesn't appeal to you:
'
' SetErrorLogFileName "myAppLogName.txt"
'
Public Enum enumLogOutputType
eDebug = 1
eMsgBox
eFile
eTable
End Enum
Private m_bLogErrors As Boolean ' flag to indicate if errors should be logged
Private m_nLogOutputType As enumLogOutputType ' set to log output type (e.g. MsgBox, File, Table, etc.)
Private m_sErrorLog As String ' log file for debug/problem support
'
Public Sub SetOutputLogType(eLogType As enumLogOutputType)
m_nLogOutputType = eLogType
End Sub
'
Public Function GetOutputLogType() As enumLogOutputType
' if not defined then set to Debug.Print
If m_nLogOutputType = 0 Then m_nLogOutputType = eDebug
GetOutputLogType = m_nLogOutputType
End Function
'
Public Function ToggleErrorLogging()
m_bLogErrors = Not m_bLogErrors
End Function
'
Public Sub SetErrorLogging(bLog As Boolean, Optional eLogType As enumLogOutputType = eDebug)
m_bLogErrors = True
m_nLogOutputType = eLogType
End Sub
'
Public Function IsErrorLogging() As Boolean
IsErrorLogging = m_bLogErrors
End Function
'
Public Sub SetErrorLogFileName(sFilename As String)
If Len(sFilename) > 0 Then
m_sErrorLog = sFilename
End If
End Sub
'
Public Function GetErrorLogFilePathName() As String
If Len(m_sErrorLog) > 0 Then
GetErrorLogFilePathName = CurrentProject.Path & "\" & m_sErrorLog
Else
GetErrorLogFilePathName = CurrentProject.Path & "\AppLog.txt"
End If
End Function
'
'
'
Public Sub LogMessage(sMessage As String)
Select Case GetOutputLogType()
Case eDebug
Debug.Print sMessage
Case eMsgBox
MsgBox sMessage, vbOKOnly Or vbInformation, "Log Output"
Case eFile
' MsgBox "File Log not implemented: " & sMessage, _
' vbOKOnly Or vbInformation, "Log Output"
LogToFile sMessage
Case eTable
' MsgBox "Table Log not implemented: " & sMessage, _
' vbOKOnly Or vbInformation, "Log Output"
LogToTable sMessage
End Select
End Sub
'
'
Private Sub LogToFile(sMessage As String)
On Error Resume Next
Dim F As Integer
F = FreeFile
Open GetErrorLogFilePathName() For Append As #F
Print #F, Format(Now(), "yyyymmdd h:mm:ss - ") & sMessage
Close #F
Reset
On Error GoTo 0
End Sub
'
'
Private Sub LogToTable(sMessage As String)
On Error Resume Next
' table has timestamp field that defaults to "=Now()"
CurrentDb.Execute "INSERT INTO SysLog (MessageText) VALUES (""" _
& sMessage & """);", dbFailOnError
End Sub
Updated 2009-02-18.
Popup Form Position
A forum member at UtterAccess asked if a pop-up form could be placed next to a control. My initial thought was the DoCmd.MoveSize command would be the answer but it wasn't that simple.
I wanted to provide a simple code solution without resorting to APIs. But that makes it difficult.
In the requested sample the popup form needs to appear to the left of the command button used to open it. Here is the code I used to do that:
Private Sub cmdPopUp_Click()
DoCmd.OpenForm "frmPopUp", , , , , , Me.Name & ";" & Me.ActiveControl.Name
End Sub
This opens the popup form ("frmPopup") and passes the name of the current form and the (command button) control on it that the user clicked in the OpenArgs argument. Then in the pop form's Load event those values are retrieved using Me.OpenArgs:
Private Sub Form_Load()
Const SMALL_GAP As Long = 100
Const TITLE_BAR_SIZE_IN_TWIPS = 500
Dim nPos As Long
Dim sForm As String, sControl As String
Dim nLeft As Long, nTop As Long
If Len(Me.OpenArgs) > 0 Then
' get the top and left positions for the popup - first find the ; in .OpenArgs
nPos = InStr(Me.OpenArgs, ";")
If nPos > 0 Then
sForm = Left$(Me.OpenArgs, nPos - 1)
sControl = Mid$(Me.OpenArgs, nPos + 1)
' first move the form to where the calling form is located
Me.Move Forms(sForm).WindowLeft, Forms(sForm).WindowTop
' and now move it to the control provided
nLeft = Me.WindowLeft + Forms(sForm).Controls(sControl).Left _
+ Forms(sForm).Controls(sControl).Width + SMALL_GAP
nTop = Me.WindowTop + Forms(sForm).Controls(sControl).Top _
+ TITLE_BAR_SIZE_IN_TWIPS
Me.Move nLeft, nTop
End If
End If
End Sub
I also have an Access 2007 sample you can download.
Updated 2009-02-04.
Measuring Performance
A common request is the ability to measure performance perhaps as part of a profiling effort to increase performance of a query or some code.
I use the code posted below in a module to get the start and end times and wrap my test code in between like this:
DoCmd.Hourglass True
Init_ExactTimer
' call my function or query
Call DetermineNumberOfPins
'CurrentDb.Execute qryMyComplexQuery
DoCmd.Hourglass False
MsgBox "Elapsed time: " & ExactTimer_Value, vbOkOnly Or vbInformation, "Results"
The timing code and some resources:
Option Compare Database
Option Explicit
' See http://support.microsoft.com/kb/q172338/ for more information
' on QueryPerformanceFrequency and QueryPerformanceCounter.
' also see this for potential inaccurate results:
' Performance counter value may unexpectedly leap forward
' http://support.microsoft.com/default.aspx?scid=KB;EN-US;Q274323&
' Cannot Run Certain Programs on Hyper-Threaded or Dual-Processor Computers
' with a CPU Speed of Greater Than 2 GHz
' http://support.microsoft.com/kb/327809/
'
' http://www-128.ibm.com/developerworks/library/i-seconds/
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (ByRef Frequency As Currency) As Long
Private Declare Function QueryPerformanceCounter Lib "kernel32" (ByRef TimerValue As Currency) As Long
'Private Const i_Frequency As Currency = 100
Private i_Frequency As Currency
' store an approximation of the API time (performance) overhead:
Private m_curOverhead As Currency ' currency is a very accurate data type for precision timing
Private m_curStart As Currency
'
' to time how long it takes for a set of instructions to be processed you would insert a call to this
' function ("Init_ExactTimer()") at the start of your code block.
' Then use the corresponding "ExactTimer_Value()"
' function (below) placed at the end of the code block to examine.
'
Public Sub Init_ExactTimer()
Dim Ctr1 As Currency, Ctr2 As Currency
QueryPerformanceFrequency i_Frequency
Debug.Print "Count change in 1 second: " & i_Frequency
Debug.Print "QueryPerformanceCounter minimum resolution: 1/" & i_Frequency * 10000; _
" sec (" & CStr(1 / (i_Frequency * 10000)) & ")"
QueryPerformanceCounter Ctr1
QueryPerformanceCounter Ctr2
m_curOverhead = Ctr2 - Ctr1 ' determine API overhead
QueryPerformanceCounter m_curStart ' set a start point
End Sub
'
' This proc returns the number of seconds between this call and the "Init_ExactTimer()" call.
'
Public Function ExactTimer_Value() As Currency
QueryPerformanceCounter ExactTimer_Value
ExactTimer_Value = ((ExactTimer_Value - m_curStart) - m_curOverhead) / i_Frequency
End Function
Updated 2009-02-12.

