Vladimír Cvajniga said:
We are talking about forms and reports: CreateForm, CreateReport,
CreateControl, CreateReportControl. I could easily live without those
because I don't need them at all. I wonder if anybody uses these functions.
CreateDatabase, CreateTable, etc., is totally different kind of stuff. I
use them quite often.
I am in the middle of using them to create a wizard to generate search
forms automatically right now. I want the wizard to allow the user to
select an Access table and some options and use the selections to create
three forms, e.g., for tblEmail frmEmailSearch, frmEmailResults,
frmEmailInfo. The first form is unbound and is used to create a dynamic
sql string that can be used to populate a read-only bound results form.
Once a record is selected from the results form, an info form (bound
or unbound depending on the selection) can be used to edit the record.
I'm almost done with the controls for the first search form. I have to
decide what to do if the table has more than 80 fields since non-date
fields are placed vertically and there's an integer twips limit on the
size of the form. Instead of using an API function so get text widths I
assume that field names are Camel Case (the user can resize the controls
afterward otherwise). I set up two textboxes for each date field. The
idea is to limit the date field to that range, but to select the exact
date if only the first textbox is filled in. I'll probably adjust the
basic idea for things like Y/N fields, but that will be after the basics
are in place. Here's the code so far:
Option Compare Database
Option Explicit
Private Sub cmdCreateSearchForms_Click()
Dim MyDB As Database
Dim MyRS As Recordset
Dim strSQL As String
Dim tdf As TableDef
Dim idx As Index
Dim fld As Field
Dim ctl As Control
Dim strFieldNames() As String
Dim intFieldTypes() As Integer
Dim intFieldActSize() As Integer
Dim intNonKeyFields As Integer
Dim intI As Integer
Dim intJ As Integer
Dim strField As String
Dim boolFieldFound As Boolean
Dim strPrimaryKeyField As String
Dim strTable As String
Dim strForm As String
Dim ctnr As Container
Dim doc As Document
Dim boolSearchFormFound As Boolean
Dim boolResultsFormFound As Boolean
Dim boolInfoFormFound As Boolean
Dim Response As Variant
Dim strPrompt As String
Dim strTitle As String
Dim frmSearch As Form
Dim frmResults As Form
Dim frmInfo As Form
Dim strSearchForm As String
Dim strResultsForm As String
Dim strInfoForm As String
Dim strCreatedForm As String
Const FORMWIDTH = 7
Const VERTSPACING = 360
Const NORMALWEIGHT = 400
Const SEMIBOLD = 600
Const TEXTALIGNLEFT = 1
Const TEXTALIGNCENTER = 2
Const TEXTALIGNRIGHT = 3
Const SHADOWED = 4
Const NORMALBACKSTYLE = 1
Dim lngFormHeightTwips As Long
Dim intDateFields As Integer
Dim intNonDateFields As Integer
Dim lngTitleTwipsL As Long
Dim lngTitleTwipsT As Long
Dim lngTitleTwipsW As Long
Dim lngTitleTwipsH As Long
Dim lngCommandNewTwipsL As Long
Dim lngCommandNewTwipsT As Long
Dim lngCommandNewTwipsW As Long
Dim lngCommandNewTwipsH As Long
Dim lngCommandGoTwipsL As Long
Dim lngCommandGoTwipsT As Long
Dim lngCommandGoTwipsW As Long
Dim lngCommandGoTwipsH As Long
Dim lngCommandExitTwipsL As Long
Dim lngCommandExitTwipsT As Long
Dim lngCommandExitTwipsW As Long
Dim lngCommandExitTwipsH As Long
Dim lngLabelsRef0TwipsL As Long
Dim lngLabelsRef0TwipsT As Long
Dim lngLabelsRef0TwipsW As Long
Dim lngLabelsRef0TwipsH As Long
Dim lngComboboxRef0TwipsL As Long
Dim lngComboboxRef0TwipsT As Long
Dim lngComboboxRef0TwipsW As Long
Dim lngComboboxRef0TwipsH As Long
Dim dblLabelMaxW As Double
Dim dblDateLabelMaxW As Double
Dim dblComboboxMaxW As Double
Dim lngDateLabelDRTwipsL As Long
Dim lngDateLabelDRTwipsT As Long
Dim lngDateLabelDRTwipsW As Long
Dim lngDateLabelDRTwipsH As Long
Dim lngDateLabelFldTwipsL As Long
Dim lngDateLabelFldTwipsT As Long
Dim lngDateLabelFldTwipsW As Long
Dim lngDateLabelFldTwipsH As Long
Dim lngDateLabelStartTwipsL As Long
Dim lngDateLabelStartTwipsT As Long
Dim lngDateLabelStartTwipsW As Long
Dim lngDateLabelStartTwipsH As Long
Dim lngDateLabelEndTwipsL As Long
Dim lngDateLabelEndTwipsT As Long
Dim lngDateLabelEndTwipsW As Long
Dim lngDateLabelEndTwipsH As Long
Dim lngDateLabelRef0TwipsL As Long
Dim lngDateLabelRef0TwipsT As Long
Dim lngDateLabelRef0TwipsW As Long
Dim lngDateLabelRef0TwipsH As Long
Dim lngNudgeDateLabelDown As Long
Const CharToInches = 0.08
If IsNull(cbxTableName.Value) Then
MsgBox ("No table has been selected.")
Exit Sub
End If
'Check for the existence of a primary key
Set MyDB = CurrentDb
Set tdf = MyDB.TableDefs(cbxTableName.Value)
strPrimaryKeyField = ""
For Each idx In tdf.Indexes
If idx.Primary = True Then
'Make sure the type of the primary key is Long
'and that it is on a single field
strField = Right(idx.Fields, Len(idx.Fields) - 1)
boolFieldFound = False
For Each fld In tdf.Fields
If fld.Name = strField Then
boolFieldFound = True
strPrimaryKeyField = strField
Exit For
End If
Next fld
If boolFieldFound = True Then
If tdf.Fields(strField).Type <> dbLong Then
MsgBox ("The primary key must have a Long data type.")
Set tdf = Nothing
Set MyDB = Nothing
Exit Sub
End If
Else
MsgBox ("The primary key must be on a single field.")
Set tdf = Nothing
Set MyDB = Nothing
Exit Sub
End If
Exit For
End If
Next idx
Set tdf = Nothing
'Allocate VERTSPACING for total number of Non-Date and Non-PK fields
unless there are lots of date fields
intDateFields = 0
intNonDateFields = 0
Set tdf = MyDB.TableDefs(cbxTableName.Value)
'I should set up an array to store the field names and their types.
intNonKeyFields = tdf.Fields.Count - 1
ReDim strFieldNames(intNonKeyFields)
ReDim intFieldTypes(intNonKeyFields)
ReDim intFieldActSize(intNonKeyFields)
For Each fld In tdf.Fields
If fld.Name <> strPrimaryKeyField Then
If fld.Type = dbDate Then
intDateFields = intDateFields + 1
Else
intNonDateFields = intNonDateFields + 1
End If
strFieldNames(intDateFields + intNonDateFields) = fld.Name
intFieldTypes(intDateFields + intNonDateFields) = fld.Type
'Get the actual max size if it's a text field, otherwise use fld.Size
If fld.Type = dbText Then
strSQL = "SELECT Max(Len(Nz(" & fld.Name & ", ''))) AS MaxLen
FROM " & cbxTableName.Value & ";"
Set MyRS = MyDB.OpenRecordset(strSQL, dbOpenSnapshot)
intFieldActSize(intDateFields + intNonDateFields) = 0
If MyRS.RecordCount > 0 Then
MyRS.MoveFirst
intFieldActSize(intDateFields + intNonDateFields) = MyRS("MaxLen")
End If
MyRS.Close
Set MyRS = Nothing
Else
intFieldActSize(intDateFields + intNonDateFields) = fld.Size
End If
End If
Next fld
Set tdf = Nothing
'MsgBox ("Date Fields: " & intDateFields)
'MsgBox ("Non-Date Fields: " & intNonDateFields)
'Determine how large vertically to make the form; allow 1/2" for title
and lower command buttons
'Allow two lines for the Date label and sublabels
If intDateFields + 2 > intNonDateFields Then
lngFormHeightTwips = (intDateFields + 2) * VERTSPACING + 1440 + 0.5 *
1440 + 0.25 * 1440
Else
lngFormHeightTwips = intNonDateFields * VERTSPACING + 1440 + 0.5 *
1440 + 0.25 * 1440
End If
strTable = cbxTableName.Value
If Left(strTable, 3) = "tbl" Then
If Len(strTable) > 3 Then
strTable = Right(strTable, Len(strTable) - 3)
End If
End If
'Check for pre-existing forms: e.g., frmMyTableSearch (tblMyTable)
boolSearchFormFound = False
boolResultsFormFound = False
boolInfoFormFound = False
strSearchForm = "frm" & strTable & "Search"
strResultsForm = "frm" & strTable & "Results"
strInfoForm = "frm" & strTable & "Info"
For Each ctnr In MyDB.Containers
If ctnr.Name = "Forms" Then
For Each doc In ctnr.Documents
Select Case doc.Name
Case strSearchForm: boolSearchFormFound = True
Case strResultsForm: boolResultsFormFound = True
Case strInfoForm: boolInfoFormFound = True
End Select
If boolSearchFormFound = True And boolResultsFormFound = True And
boolInfoFormFound = True Then Exit For
Next doc
End If
Next ctnr
If boolSearchFormFound = True Then
strPrompt = strSearchForm & " already exists. Delete?"
strTitle = "Action Confirmation"
Response = MsgBox(strPrompt, vbOKCancel, strTitle)
If Response <> vbOK Then
Set MyDB = Nothing
Exit Sub
End If
DoCmd.DeleteObject acForm, strSearchForm
End If
If boolResultsFormFound = True Then
strPrompt = strResultsForm & " already exists. Delete?"
strTitle = "Action Confirmation"
Response = MsgBox(strPrompt, vbOKCancel, strTitle)
If Response <> vbOK Then
Set MyDB = Nothing
Exit Sub
End If
DoCmd.DeleteObject acForm, strResultsForm
End If
If boolInfoFormFound = True Then
strPrompt = strInfoForm & " already exists. Delete?"
strTitle = "Action Confirmation"
Response = MsgBox(strPrompt, vbOKCancel, strTitle)
If Response <> vbOK Then
Set MyDB = Nothing
Exit Sub
End If
DoCmd.DeleteObject acForm, strInfoForm
End If
DoEvents
Set frmSearch = CreateForm()
'Set basic form properties
frmSearch.HasModule = True
frmSearch.ViewsAllowed = 1 'Form
frmSearch.ScrollBars = 2 'Vertical Only
frmSearch.RecordSelectors = False
frmSearch.NavigationButtons = False
frmSearch.DividingLines = False
frmSearch.ShortcutMenu = False
frmSearch.Width = FORMWIDTH * 1440
frmSearch.Section(acDetail).Height = lngFormHeightTwips
strCreatedForm = frmSearch.Name
'Add Controls and code to the newly created form after it has been renamed
DoCmd.Close acForm, strCreatedForm, acSaveYes
Do While IsFormOpen(strCreatedForm)
DoEvents
Loop
Set frmSearch = Nothing
DoCmd.Rename strSearchForm, acForm, strCreatedForm
DoEvents
DoCmd.OpenForm strSearchForm, acDesign
DoEvents
lngTitleTwipsL = 2.5 * 1440
lngTitleTwipsT = 0.25 * 1440
lngTitleTwipsW = 2 * 1440
lngTitleTwipsH = 0.25 * 1440
lngCommandNewTwipsW = 0.875 * 1440
lngCommandNewTwipsH = 0.25 * 1440
lngCommandNewTwipsT = lngTitleTwipsT
lngCommandNewTwipsL = Int((lngTitleTwipsL - lngCommandNewTwipsW) / 2)
Set ctl = CreateControl(strSearchForm, acLabel, , "lblTitle", ,
lngTitleTwipsL, lngTitleTwipsT)
Call SetControlProperties(ctl, "lblTitle", 12, SEMIBOLD,
TEXTALIGNCENTER, lngTitleTwipsW, lngTitleTwipsH, "Search Form")
Set ctl = Nothing
Set ctl = CreateControl(strSearchForm, acCommandButton, acDetail, ,
"New", lngCommandNewTwipsL, lngCommandNewTwipsT)
Call SetControlProperties(ctl, "cmdNew", 10, SEMIBOLD, ,
lngCommandNewTwipsW, lngCommandNewTwipsH, "New")
Set ctl = Nothing
'Do any non-date fields first
'Allocate 1.05" for every 10 characters at 10 point
dblLabelMaxW = GetMaximumLabelSize(strFieldNames(), intFieldTypes(), 10,
"NonDate") 'Characters
'Convert to inches
dblLabelMaxW = dblLabelMaxW * CharToInches
lngLabelsRef0TwipsL = 0.5 * 1440
lngLabelsRef0TwipsT = 0.75 * 1440
lngLabelsRef0TwipsW = dblLabelMaxW * 1440
lngLabelsRef0TwipsH = 0.8 * VERTSPACING
dblComboboxMaxW = GetMaximumTextFieldSize(intFieldTypes(),
intFieldActSize(), 20) 'Characters
'Convert to inches
dblComboboxMaxW = dblComboboxMaxW * CharToInches
lngComboboxRef0TwipsL = lngLabelsRef0TwipsL + lngLabelsRef0TwipsW + 0.25
* 1440
lngComboboxRef0TwipsT = 0.75 * 1440
lngComboboxRef0TwipsW = dblComboboxMaxW * 1440
lngComboboxRef0TwipsH = 0.8 * VERTSPACING
If intNonDateFields > 0 Then
For intI = 1 To intNonKeyFields
If intFieldTypes(intI) <> dbDate Then
'Set up the label
Set ctl = CreateControl(strSearchForm, acLabel, , "lbl" &
strFieldNames(intI), , lngLabelsRef0TwipsL, lngLabelsRef0TwipsT + (intI
- 1) * VERTSPACING)
Call SetControlProperties(ctl, "lbl" & strFieldNames(intI), 10,
NORMALWEIGHT, TEXTALIGNRIGHT, lngLabelsRef0TwipsW, lngLabelsRef0TwipsH,
strFieldNames(intI))
'Set up the combobox
Set ctl = CreateControl(strSearchForm, acComboBox, , , ,
lngComboboxRef0TwipsL, lngComboboxRef0TwipsT + (intI - 1) * VERTSPACING)
Call SetControlProperties(ctl, "cbx" & strFieldNames(intI), 10,
NORMALWEIGHT, TEXTALIGNLEFT, lngComboboxRef0TwipsW, lngComboboxRef0TwipsH)
ctl.Properties("RowSource") = "SELECT DISTINCT " &
strFieldNames(intI) & " FROM " & cbxTableName.Value & " WHERE " &
strFieldNames(intI) & " IS NOT NULL ORDER BY " & strFieldNames(intI) & ";"
End If
Next intI
End If
'If date fields exist, set up some labels and textboxes for them
dblDateLabelMaxW = GetMaximumLabelSize(strFieldNames(), intFieldTypes(),
10, "Date") 'Characters
'Convert to inches
dblDateLabelMaxW = dblDateLabelMaxW * CharToInches
lngDateLabelDRTwipsL = lngComboboxRef0TwipsL + lngComboboxRef0TwipsW +
(0.5 + dblDateLabelMaxW) * 1440
lngDateLabelDRTwipsT = lngComboboxRef0TwipsT
lngDateLabelDRTwipsW = 1800
lngDateLabelDRTwipsH = 288
lngDateLabelFldTwipsL = lngComboboxRef0TwipsL + lngComboboxRef0TwipsW +
0.5 * 1440
lngDateLabelFldTwipsT = lngComboboxRef0TwipsT
lngDateLabelFldTwipsW = dblDateLabelMaxW * 1440
lngDateLabelFldTwipsH = 288
lngDateLabelStartTwipsL = lngComboboxRef0TwipsL + lngComboboxRef0TwipsW
+ (dblDateLabelMaxW + 0.8) * 1440
lngDateLabelStartTwipsT = lngComboboxRef0TwipsT
lngDateLabelStartTwipsW = 864
lngDateLabelStartTwipsH = 288
lngDateLabelEndTwipsL = lngComboboxRef0TwipsL + lngComboboxRef0TwipsW +
(dblDateLabelMaxW + 1.6) * 1440
lngDateLabelEndTwipsT = lngComboboxRef0TwipsT
lngDateLabelEndTwipsW = 864
lngDateLabelEndTwipsH = 288
lngDateLabelRef0TwipsL = lngComboboxRef0TwipsL + lngComboboxRef0TwipsW +
0.5 * 1440
lngDateLabelRef0TwipsT = lngComboboxRef0TwipsT
lngDateLabelRef0TwipsW = dblDateLabelMaxW * 1440
lngDateLabelRef0TwipsH = 0.8 * VERTSPACING
lngNudgeDateLabelDown = 30
If intDateFields > 0 Then
'Set up the four labels
'Date Ranges
Set ctl = CreateControl(strSearchForm, acLabel, , "lbl_DateRanges", ,
lngDateLabelDRTwipsL, lngDateLabelDRTwipsT)
Call SetControlProperties(ctl, "lbl_DateRanges", 10, SEMIBOLD,
TEXTALIGNCENTER, lngDateLabelDRTwipsW, lngDateLabelDRTwipsH, "Date
Ranges", NORMALBACKSTYLE, , SHADOWED, , 2)
'Field
Set ctl = CreateControl(strSearchForm, acLabel, , "lbl_Field", ,
lngDateLabelFldTwipsL, lngDateLabelFldTwipsT + VERTSPACING)
Call SetControlProperties(ctl, "lbl_Field", 8, SEMIBOLD,
TEXTALIGNCENTER, lngDateLabelFldTwipsW, lngDateLabelFldTwipsH, "Field",
NORMALBACKSTYLE, , SHADOWED, , 2)
'Starting
Set ctl = CreateControl(strSearchForm, acLabel, , "lbl_Starting", ,
lngDateLabelStartTwipsL, lngDateLabelStartTwipsT + VERTSPACING)
Call SetControlProperties(ctl, "lbl_Starting", 8, SEMIBOLD,
TEXTALIGNCENTER, lngDateLabelStartTwipsW, lngDateLabelStartTwipsH,
"Starting", NORMALBACKSTYLE, , SHADOWED, , 2)
'Ending
Set ctl = CreateControl(strSearchForm, acLabel, , "lbl_Ending", ,
lngDateLabelEndTwipsL, lngDateLabelEndTwipsT + VERTSPACING)
Call SetControlProperties(ctl, "lbl_Ending", 8, SEMIBOLD,
TEXTALIGNCENTER, lngDateLabelEndTwipsW, lngDateLabelEndTwipsH, "Ending",
NORMALBACKSTYLE, , SHADOWED, , 2)
intJ = 0 'Keep track of jth date field
For intI = 1 To intNonKeyFields
If intFieldTypes(intI) = dbDate Then
intJ = intJ + 1
'Set up the label
Set ctl = CreateControl(strSearchForm, acLabel, , "lbl_" &
strFieldNames(intI), , lngDateLabelRef0TwipsL, lngDateLabelRef0TwipsT +
(intJ + 1) * VERTSPACING + lngNudgeDateLabelDown)
Call SetControlProperties(ctl, "lbl_" & strFieldNames(intI), 8,
NORMALWEIGHT, TEXTALIGNRIGHT, lngDateLabelRef0TwipsW,
lngDateLabelRef0TwipsH, strFieldNames(intI), , , , , 2)
'Set up the date textboxes
Set ctl = CreateControl(strSearchForm, acTextBox, , , ,
lngDateLabelStartTwipsL, lngDateLabelRef0TwipsT + (intJ + 1) * VERTSPACING)
Call SetControlProperties(ctl, "txt" & strFieldNames(intI) &
"Start", 10, NORMALWEIGHT, TEXTALIGNLEFT, lngDateLabelStartTwipsW,
lngDateLabelRef0TwipsH)
Set ctl = CreateControl(strSearchForm, acTextBox, , , ,
lngDateLabelEndTwipsL, lngDateLabelRef0TwipsT + (intJ + 1) * VERTSPACING)
Call SetControlProperties(ctl, "txt" & strFieldNames(intI) &
"End", 10, NORMALWEIGHT, TEXTALIGNLEFT, lngDateLabelStartTwipsW,
lngDateLabelRef0TwipsH)
End If
Next intI
Set ctl = Nothing
End If
'Set up the final two command buttons
'The bottom 1/2" was saved for them, so for 1/4" height command buttons
centered vertically:
'top = lngFormHeightTwips - 0.375 * 1440
lngCommandGoTwipsL = lngTitleTwipsL - 0.75 * 1440 + lngTitleTwipsW / 2
lngCommandGoTwipsT = lngFormHeightTwips - 0.375 * 1440
lngCommandGoTwipsW = lngCommandNewTwipsW
lngCommandGoTwipsH = lngCommandNewTwipsH
lngCommandExitTwipsL = lngTitleTwipsL + 0.75 * 1440 + lngTitleTwipsW / 2
lngCommandExitTwipsT = lngCommandGoTwipsT
lngCommandExitTwipsW = lngCommandNewTwipsW
lngCommandExitTwipsH = lngCommandNewTwipsH
Set ctl = CreateControl(strSearchForm, acCommandButton, acDetail, ,
"Go", lngCommandGoTwipsL, lngCommandGoTwipsT)
Call SetControlProperties(ctl, "cmdGo", 10, SEMIBOLD, ,
lngCommandGoTwipsW, lngCommandGoTwipsH, "Go")
Set ctl = CreateControl(strSearchForm, acCommandButton, acDetail, ,
"Exit", lngCommandExitTwipsL, lngCommandExitTwipsT)
Call SetControlProperties(ctl, "cmdExit", 10, SEMIBOLD, ,
lngCommandExitTwipsW, lngCommandExitTwipsH, "Exit")
Erase strFieldNames
Erase intFieldTypes
Erase intFieldActSize
DoCmd.Restore
DoCmd.Close acForm, strSearchForm, acSaveYes
DoEvents
Set MyDB = Nothing
End Sub
Private Sub cmdExit_Click()
DoCmd.Close acForm, Me.Name
End Sub
Private Function GetMaximumLabelSize(strNames() As String, intTypes() As
Integer, intMinimum As Integer, strType) As Integer
Dim lngI As Long
Dim intMax As Integer
intMax = intMinimum
For lngI = 1 To UBound(strNames())
If strType = "Date" Then
If intTypes(lngI) = dbDate Then
If Len(strNames(lngI)) > intMax Then
intMax = Len(strNames(lngI))
End If
End If
Else
If intTypes(lngI) <> dbDate Then
If Len(strNames(lngI)) > intMax Then
intMax = Len(strNames(lngI))
End If
End If
End If
Next lngI
GetMaximumLabelSize = intMax
End Function
Private Function GetMaximumTextFieldSize(strTypes() As Integer,
strSizes() As Integer, intMinimum As Integer) As Integer
Dim lngI As Long
Dim intMax As Integer
intMax = intMinimum
For lngI = 1 To UBound(strTypes())
If strTypes(lngI) = dbText Then
If strSizes(lngI) > intMax Then
intMax = strSizes(lngI)
End If
End If
Next lngI
GetMaximumTextFieldSize = intMax
End Function
Private Sub Form_Load()
Dim MyDB As Database
Dim tdf As TableDef
Dim strList As String
'Create the list of tables
strList = ""
Set MyDB = CurrentDb
For Each tdf In MyDB.TableDefs
If Left(tdf.Name, 4) <> "MSys" Then
strList = strList & tdf.Name & ";"
End If
Next tdf
Set MyDB = Nothing
If Len(strList) > 0 Then strList = Left(strList, Len(strList) - 1)
cbxTableName.RowSourceType = "Value List"
cbxTableName.RowSource = strList
End Sub
Public Function IsFormOpen(strForm As String) As Boolean
Dim frmX As Form
IsFormOpen = False
For Each frmX In Forms
If frmX.Name = strForm Then
IsFormOpen = True
Exit For
End If
Next frmX
End Function
Private Sub SetControlProperties(ctl As Control, Optional strName As
String, Optional intFontSize As Integer, Optional intFontWeight As
Integer, Optional intTextAlign As Integer, Optional lngWidthTwips As
Long, Optional lngHeightTwips As Long, Optional strCaption As String,
Optional intBackStyle As Integer, Optional lngBackColor As Long,
Optional intSpecialEffect As Integer, Optional lngBorderColor As Long,
Optional intBorderWidth As Integer)
If Not IsMissing(strName) Then ctl.Properties("Name") = strName
If intFontSize <> 0 Then ctl.Properties("FontSize") = intFontSize
If intFontWeight <> 0 Then ctl.Properties("FontWeight") = intFontWeight
If intTextAlign <> 0 Then ctl.Properties("TextAlign") = intTextAlign
If lngHeightTwips <> 0 Then ctl.Properties("Height") = lngHeightTwips
If lngWidthTwips <> 0 Then ctl.Properties("Width") = lngWidthTwips
If strCaption <> "" Then ctl.Properties("Caption") = strCaption
If intBackStyle <> 0 Then ctl.Properties("BackStyle") = intBackStyle
If lngBackColor <> 0 Then ctl.Properties("BackColor") = lngBackColor
If intSpecialEffect <> 0 Then ctl.Properties("SpecialEffect") =
intSpecialEffect
If lngBorderColor <> 0 Then ctl.Properties("BorderColor") = lngBorderColor
If intBorderWidth <> 0 Then ctl.Properties("BorderWidth") = intBorderWidth
End Sub
James A. Fortune
(e-mail address removed)