Creating form from code

D

David W. Fenton

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.

Well, it wasn't designed specifically for *you*. I'm sure there are
commands I never use that you use all the time (and vice versa), but
I'm not calling for the elimination of those commands just because I
don't use them.
 
D

David W. Fenton

Users edit recordsets based on queries. I never give user an
option to edit a table in table view. I'd like automatic report
based on current form's recordset.

You can create a datasheet form that replicates the table view and
gives you the ability to do all sorts of additional things
(everything you can do in a form).
 
D

David W. Fenton

Example to call a sub-project in PC FAND:
Call(SubProject)
or
Call(SubProject,SpecificProcedureOrFunction)
The second one is simply SUPERB!!! In Access: I think it can be
done via reference to an appropriate MDE, but I think you must
specify all data connections to each sub-projects' databases from
main project :-(.

No, actually, you don't need to do that at all. I call the Zoom
wizard in my apps (the same one that is called with Shift F2) and I
do it with no reference set using Application.Run.
In MS Access terms:
- I have a main project (Main.mde) for commonc functions & a
dashboard - I have several sub-projects (Sub1.mde, Sub2.mde,
Sub3.mde) for specific tasks
- I'd like to use Call "Sub1.mde" (imagine some kind of dashboard)
from within Main.mde; any sub-project can recognize & use all
functions declared in Main.mde... as well as tables (data
connections), forms, reports, etc.

Investigate Application.Run.
Have you ever programmed accountings & taxes & earnings &
properties (& more)? Can you imagine all of these in one project?

I've dealt with parts of that and still can't imagine how you'd need
that mean objects.
 
V

Vladimír Cvajniga

Project scenario (based on file system, ie. sub-project is in an appropriate
sub-dir, but it can be re-directed through so called Catalog; as it works in
PC FAND !!!):
http://img7.imagevenue.com/img.php?image=84348_Project_122_146lo.jpg

If MS Access had this functionality I wouldn't need ANY references to
library databases... neither I would need ANY add-in!

I think that Application.Run can't do anything like that because it runs as
a separate task, ie. it can't see superior functions in main project.

Vlado

P.S. In PC FAND you can call a simple procedure in any sub-project from main
project! When you Call(SubProject,Procedure) it opens the sub-project. But
it runs only a bit of it's code.
Unfortunatelly, PC FAND has no Windows version. If PC FAND was transformed
for Windows I would never try MS Access.
 
V

Vladimír Cvajniga

I think I was right. I've tried Application.Run according to MS Access 2002
help. Application runs as a separate task. :-(

Vlado

Vladimír Cvajniga said:
Project scenario (based on file system, ie. sub-project is in an
appropriate sub-dir, but it can be re-directed through so called Catalog;
as it works in PC FAND !!!):
http://img7.imagevenue.com/img.php?image=84348_Project_122_146lo.jpg

If MS Access had this functionality I wouldn't need ANY references to
library databases... neither I would need ANY add-in!

I think that Application.Run can't do anything like that because it runs
as a separate task, ie. it can't see superior functions in main project.

Vlado

P.S. In PC FAND you can call a simple procedure in any sub-project from
main project! When you Call(SubProject,Procedure) it opens the
sub-project. But it runs only a bit of it's code.
Unfortunatelly, PC FAND has no Windows version. If PC FAND was transformed
for Windows I would never try MS Access.
 
V

Vladimír Cvajniga

One more thing:

When a sub-project is called both main project & sub-project should run as
one task. They should perform as one joined project! This is what you might
not understand. PC FAND's philosophy is a bit diffrent from MS Access's one.
:)

Vlado

Vladimír Cvajniga said:
Project scenario (based on file system, ie. sub-project is in an
appropriate sub-dir, but it can be re-directed through so called Catalog;
as it works in PC FAND !!!):
http://img7.imagevenue.com/img.php?image=84348_Project_122_146lo.jpg

If MS Access had this functionality I wouldn't need ANY references to
library databases... neither I would need ANY add-in!

I think that Application.Run can't do anything like that because it runs
as a separate task, ie. it can't see superior functions in main project.

Vlado

P.S. In PC FAND you can call a simple procedure in any sub-project from
main project! When you Call(SubProject,Procedure) it opens the
sub-project. But it runs only a bit of it's code.
Unfortunatelly, PC FAND has no Windows version. If PC FAND was transformed
for Windows I would never try MS Access.
 
J

James A. Fortune

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)
 
D

David W. Fenton

I think I was right. I've tried Application.Run according to MS
Access 2002 help. Application runs as a separate task.

Not if you're running a wizard/library database. For instance, to
call the Zoom box from the Utility wizard, you call this:

Application.Run("UTILITY.BuilderZoom", strObjName, _
strCtlName, strCurrValue)

(with appropriate values for the arguments, of course).

It doesn't run out of process, but within the current instance of
Access. Of course, you are also passing the data in and the control
names, and internally the code is doing what is necessary to update
the control you called it from.

But it *definitely* works. In fact, it's how Access launches its
wizards (which are really just MDEs written in VBA and Access).
 
D

David W. Fenton

When a sub-project is called both main project & sub-project
should run as one task.

When Access uses its built-in wizards and when I call the ZoomBox
function in the Utility wizard, it does not run out of process. Same
for when you create a reference to a library database.

So, I really don't know what you're talking about.
 
V

Vladimír Cvajniga

I'll have to check and see how I can handle database access. I think I
must define connections for all tables in main project instead of handling
them seperatly in "sub-project" FE DBs. I have tried to call a public sub in
a referenced MDB (sub-project) to run sub-project's main form but I've got
problems with data connections and with file system based operations. It
seems that all necessary files in sub-project's directory (external EXEs,
local DBs, etc.) should be moved to main project directory... due to CurDir,
CurrentDb.Name, and similar functions.
In other words: sub-project runs OK if it's run separately. From main
project I can't easily call a public function in a referenced MDB to run
the sub-project. It seems it's necessary to make many changes in sub-project
so that it could be run from main project.


Main project: c:\Documents and Settings\Vlado\Dokumenty\Dashboard.mdb.
Sub-project (FE): c:\Documents and Settings\Vlado\Dokumenty\_Moje
projekty\KEO\EO11.mdb
Sub-project FE handles two main databases, one on MySQL-server, another one
is BE MDB for EO11's data. I use several temporary databases for different
tasks which reside in EO11.mdb's dir ()c:\Documents and
Settings\Vlado\Dokumenty\_Moje projekty\KEO\.

EO11.mdb run fine if it's run separately.

1) I have added a public procedure to one of sub-project's modules:
Public Sub RunProject()
DoCmd.OpenForm "frm_Login"
End Sub

.... and a function for testing:
Public Function fncCurrentDBname()
MsgBox CurrentDb.Name
End Function

2) I have created a new "main" project and added a reference to a
sub-project MDB.

3) I have created a "dashboard" form in main project with two buttons:
Private Sub btnEO11_Click()
EO11.modMain.RunProject
End Sub

It should open EO11.mdb's (there are some functions that work with
CurrentDB.Name on a start-up). See below.

Private Sub btnTest_Click()
EO11.modMain.fncCurrentDBname
End Sub

When I click btnTest I get a message-box with the following path:
c:\Documents and Settings\Vlado\Dokumenty\Dashboard.mdb

It's a path of main project MDB! But I'd expect
c:\Documents and Settings\Vlado\Dokumenty\_Moje projekty\KEO\EO11.mdb

So... I'm affraid I can't use this scenario. I may be doing something wrong.
But I can't imagine that should have to re-programm all file-system based
stuff. :O

And more... when I click btnEO11 I get run-time error 2485 concerning
menubar talking something about macro: Microsoft Access couldn't find macro
HobbyMenu.
- HobbyMenu is EO11's menubar.
- I never use macros.

Don't understand what I'm doing wrong. But I'm sure I can't use any
file-system-based functions in sub-project.

Vlado

P.S. Thenk you for your time.
 
D

David W. Fenton

So... I'm affraid I can't use this scenario. I may be doing
something wrong.

You can set the recordsource of the form loaded from a library
database at runtime, using the "IN 'database.mdb'" clause to set
which database the tables are drawn from. You would do this in the
form's OnOpen event. You wouldn't have any linked tables in your
library database at all.

I suggest that you attempt to acquire the Access Developers Handbook
which covers the whole process of using library databases in great
detail.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top