We first identify what common code will be useful when dealing with the business object and reporting tools. In this example, I’ve chosen the OutputMedium property and the methods described in Table 3-6. The developer can set the OutputMedium property to indicate which report component will be used. In this example, we have three possibilities: Word, Excel, and rich text box.
Table 3-6
Methods in the ActiveX DLL
| Method | Description |
| Report Component Methods | |
|
Automatically opens the report component and provides the developer with a reference to the report component. Some of the components do not need to be opened; for example, a rich text box preexists on a form. |
|
Prepares the report component for data population. |
|
Populates a predefined cell with data. A cell in this example references a descriptor in an object that will be replaced with data. |
|
Removes a row within a report component. |
|
Duplicates a row within a report component. |
| Business Object Methods | |
|
Extracts text from the report component that contains the report criteria. |
|
Extracts data from the variant that holds data delimited by control characters. |
Using the OutputMedium property and these methods, a developer can create detailed reports without having detailed knowledge of the business object or the report component being used. The following code uses the control layer object to produce a report in Microsoft Excel.
Sub Example()
' Set up the variables required; objOutput is a global object.
Dim cmUtils As New CommonMethodsAndProperties
Dim csCompDet As New CompanyDetails
Dim vFrom As Variant
Dim vList As Variant
Dim nPos As Integer
' Indicate that Excel should be used, with a particular template.
cmUtils.OutputMedium = cmToExcel
cmUtils.OpenOutputMedium objOutput, "Template.xlt"
' Grab any criteria held within the template.
vFrom = cmUtils.ExtractCriteria(objOutput, _
":FilterStart:", ":FilterEnd:")
' Pass this on to the business object to build the criteria.
csCompDet.BuildCompanyCriteria vFrom, _
vNoOfItems, vCompanyID, vCompanyDescription, _
vCompanyInceptionDate, vCompanyCategory
' Tell the business object to build the result set.
csCompDet.BuildCompanyList Limit:=vNoOfItems, _
CompanyID:=vCompanyID,_
CompanyDescription:=vCompanyDescription, _
CompanyInceptionDate:=vCompanyInceptionDate, _
CompanyCategory:=vCompanyCategory
' Get the result set.
vList = csCompDet.GetCompanyList
' Prepare Excel for the data load.
cmUtils.PrepareOutputMedium objOutput
' Loop through all company details, and populate the cells.
For nPos = 1 To UBound(vList, 1)
cmUtils.InsertCopyRow objOutput, ":CmpID:"
cmUtils.PopulateCell objOutput, ":CmpDesc:", "" & _
cmUtils.StripData(vList(nPos), 2, Chr(9))
§
Next nPos
' Delete the remaining row, a result of the InsertCopyRow method.
cmUtils.DeleteRow objOutput, ":CmpID:"
' Now prepare Excel for viewing the result.
cmUtils.PrepareOutputMedium objOutput
End SubThe control layer simplifies the task considerably for the developer, especially when dealing with products that don’t have common object structures or code syntax, as the following code (used to find a string) demonstrates:
obj.SelStart = 0
obj.SelLength = 0
vFoundValue = obj.Find(striFind)obj.Range("A1").Activate
vFoundValue = obj.Cells.Find(What:= striFind)obj.StartOfDocument
obj.EditFind striFindIt is far easier for the developer to remember one syntax rather than all three of these. For example, use v = cs.Find Text:=striFind, where the cs references the common ActiveX DLL containing the Find property.
Because VBCommonMethodsAndProperties.cls and CommonMethodsAndProperties.cls are similar in content, I concentrate on the latter, which is wrapped into an ActiveX DLL project. The project consists only of the CommonMethodsAndProperties class, which is set to GlobalMultiUse to ensure that we have only one DLL in existence for the application using it.
In the Declaration section, I set up two public properties, using Public and Enum to reference the type of report object we’re working with. I use nOutputMedium with the Property Get and Property Let routines to hold the current report type. The Class_Initialize routine ensures that the Excel report type is the default.
Option Explicit
Private nOutputMedium As Integer
Public Enum Constants
cmToWord = 1 ' Produce output in Word.
cmToExcel = 2 ' Produce output in Excel.
End Enum
Private Sub Class_Initialize()
OutputMedium = cmToExcel
End Sub
Public Property Get OutputMedium()
OutputMedium = nOutputMedium
End Property
Public Property Let OutputMedium(ByVal Method As Variant)
nOutputMedium = CInt(Method)
End PropertyThe OpenOutputMedium method activates a user-selected object, in this case Word or Excel. In the Word section of the code, no error trap is required around the opening of a document because only one instance of Word.basic for Word 6/7 can exist at any one time. If no instance exists, one is automatically created, ensuring that no further checks are necessary to see whether we need to create the object.
Sub OpenOutputMedium(obj As Object, _
Optional sFileName As String)
Select Case OutputMedium
Case cmToWord
If sFileName <> "" Then
Set obj = CreateObject("Word.basic")
obj.Fileopen sFileName
Else
Set obj = CreateObject("Word.basic")
End If
Case cmToExcel
On Error Resume Next
Set obj = GetObject(, "Excel.application")
If Err > 0 Then
Set obj = CreateObject("Excel.application")
End If
Err.Clear
On Error GoTo 0
If sFileName <> "" Then
obj.Workbooks.Open filename:=sFileName
End If
End Select
End SubThe PrepareOutputMedium routine is necessary to help with performance problems. It toggles the report object window between minimum (or as small as is feasible) and maximum states to avoid excessive screen refresh.
Public Static Sub PrepareOutputMedium(obj As Object)
Dim blnOnOff As Boolean
blnOnOff = Not blnOnOff ' Toggle true/false
Select Case OutputMedium
Case cmToWord
If blnOnOff = False Then
obj.DocMaximize
obj.StartOfDocument
Else
' We must not minimize the window because we will
' lose focus to it.
If obj.DocMaximize() Or obj.DocMinimize() Then
obj.DocRestore
End If
' Make 1/20 of the application size to help keep
' screen refreshes of the active document to a
' minimum. An error would occur if
' Word had the document minimized.
obj.DocSize (Val(obj.AppInfo$(6)) * _
0.05), Val(obj.AppInfo$(7) * 0.05)
End If
Case cmToExcel
If blnOnOff = False Then
obj.ActiveWindow.WindowState = xlMaximized
obj.Range("A1").Activate
Else
obj.ActiveWindow.WindowState = xlMinimized
End If
End Select
End SubThe InsertCopyRow routine is used to copy a row that is identified by the contents of striFind. This routine provides us with a useful technique for copying the style of a row while preserving the original row, which will be populated with data. In the Word section of the Case statement, I’ve checked whether or not a table is being used. This is necessary because the statements to copy a row in a table are different from those to copy to a standard line of text.
Public Sub InsertCopyRow(obj As Object, striFind As String)
Dim nFoundPos As Integer
Select Case OutputMedium
Case cmToWord
obj.StartOfDocument
obj.EditFind striFind
nFoundPos = obj.GetSelStartPos()
' Find out whether we are in a table.
On Error Resume Next
obj.TableSelectTable
If Err > 0 Then
' No - copy line.
obj.EndOfLine 1
obj.EditCopy
obj.EndOfLine
obj.InsertPara
Else
' Yes - reset selection point.
obj.SetSelRange nFoundPos, nFoundPos
obj.TableSelectRow
obj.EditCopy
End If
obj.EditPaste
Case cmToExcel
obj.Range("A1").Activate
obj.Cells.Find(What:=striFind, _
After:=obj.ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Activate
nFoundPos = obj.ActiveCell.Row
obj.Rows(nFoundPos & ":" & nFoundPos).Select
obj.Selection.Copy
obj.Rows(nFoundPos + 1 & ":" & nFoundPos _
+ 1).Select
obj.Selection.Insert Shift:=0
End Select
End SubThe DeleteRow routine deletes the row identified by the contents of striFind. Again, we need to check whether or not we are in a table when using Word.
Public Sub DeleteRow(obj As Object, striFind As String)
Dim nFoundPos As Integer
Select Case OutputMedium
Case cmToWord
obj.StartOfDocument
obj.EditFind striFind
nFoundPos = obj.GetSelStartPos()
' Find out whether we are in a table.
On Error Resume Next
obj.TableSelectTable
If Err > 0 Then
' No - delete line.
obj.EndOfLine 1
obj.EditClear
Else
' Yes - reset selection point.
obj.SetSelRange nFoundPos, nFoundPos
obj.TableDeleteRow
End If
Case cmToExcel
obj.Cells.Find(What:=striFind, _
After:=obj.ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False).Activate
nFoundPos = obj.ActiveCell.Row
obj.Rows(nFoundPos & ":" & nFoundPos).Select
obj.Selection.Delete Shift:=xlUp
End Select
End SubThe PopulateCell routine finds a field descriptor and replaces it with the contents of striReplace. Notice that the routine always searches from the start of the object. This ensures that the first occurrence of the field descriptor is detected; keep in mind that there will always be two or more field descriptors while rows are being added to a report. The second occurrence of the descriptor is needed to keep the format and location of the cells that require population while the first copy is overwritten with text.
Sub PopulateCell(obj As Object, striFind As String, _
striReplace As String)
Dim nFoundPos As Integer
Dim nFoundLength As Integer
Select Case OutputMedium
Case cmToWord
obj.StartOfDocument
obj.EditFind striFind, _
striReplace, 0, 0, 0, 0, 0, 0, 1
Case cmToExcel
obj.Range("A1").Activate
obj.Cells.Find(What:=striFind, _
After:=obj.ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Activate
nFoundPos = obj.ActiveCell.Row
obj.Rows(nFoundPos & ":" & nFoundPos).Select
obj.Selection.Replace What:=striFind, _
Replacement:=striReplace, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
End Select
End SubThe StripData routine shown on page 122 is used to extract text between the niPos - 1 and niPos occurrences of the contents of sCompare.
Public Function StripData(ByVal viData As Variant, _
ByVal niPos As Integer, ByVal sCompare As String) _
As Variant
Dim nStartPos As Integer
Dim nEndPos As Integer
Dim nPos As Integer
nEndPos = 0
For nPos = 1 To niPos
nStartPos = nEndPos + 1
nEndPos = InStr(nStartPos + 1, viData, sCompare)
Next nPos
If nEndPos = 0 Then nEndPos = Len(viData) + 1
StripData = Mid(viData, nStartPos, nEndPos - nStartPos)
End FunctionThe ExtractCriteria routine extracts text from the report object identified by the contents of sCriteriaStart and sCriteriaEnd. These fields are used to determine the start and end points of the selection criteria entered by the user. You need to know where the criteria are located because you might have more than one set of criteria per report. The following routine is designed to extract the criteria entered in report output medium:
Public Function ExtractCriteria(obj As Object, _
ByVal sCriteriaStart As String, _
ByVal sCriteriaEnd As String) As Variant
Dim nFoundStartPos As Integer
Dim nFoundEndPos As Integer
Dim sRTFText As String
Dim vTempCriteria As Variant
vTempCriteria = ""
Select Case OutputMedium
Case cmToWord
obj.StartOfDocument
obj.EditFind sCriteriaStart, "", _
0, 0, 0, 0, 0, 0, 1
nFoundStartPos = obj.GetSelStartPos()
obj.StartOfDocument
obj.EditFind sCriteriaEnd, "", 0, 0, 0, 0, 0, 0, 1
nFoundEndPos = obj.GetSelEndPos()
vTempCriteria = _
obj.GetText$(nFoundStartPos, nFoundEndPos)
obj.SetSelRange nFoundStartPos, nFoundEndPos
obj.EditClear
Case cmToExcel
obj.Range("A1").Activate
obj.Cells.Find(What:=sCriteriaStart, _
After:=obj.ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Activate
nFoundStartPos = obj.ActiveCell.Row
obj.Cells.Find(What:=sCriteriaEnd, _
After:=obj.ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Activate
nFoundEndPos = obj.ActiveCell.Row
obj.Rows(nFoundStartPos & ":" & _
nFoundEndPos).Select
obj.Selection.Copy
vTempCriteria = Clipboard.GetText
obj.Selection.Delete Shift:=xlUp
obj.CutCopyMode = False
obj.Range("A1").Activate
End Select
' Now remove the Start and Criteria statements
' if they still exist.
If vTempCriteria & "" <> "" Then
If InStr(vTempCriteria, sCriteriaEnd) > 0 Then
vTempCriteria = Left(vTempCriteria, _
Len(vTempCriteria) - Len(sCriteriaEnd))
End If
If InStr(vTempCriteria, sCriteriaStart) > 0 Then
vTempCriteria = Right(vTempCriteria, _
Len(vTempCriteria) - Len(sCriteriaStart))
End If
End If
ExtractCriteria = vTempCriteria
End Function