CreateEventProc error

One of the controls being added is a subform (along with setting its
ObjectSource), which seems to be the cause of the prompt. If I don't add the
subform, the prompt is not raised. Any ideas how to suppress the prompt
caused by the subform?

thansk
--
dchman


"Dirk Goldgar" wrote:

"dchman" wrote in message

Since you'all could do it, i decided to try it in a new database
outside of my application, and I was also successful. After much
consternation, I noticed that the controls in my application had
names which contain the pipe character |, while my test case didn't.
I changed how the controls were named and presto, success, with one
quirk.

There may be a way to work around that, but the pipe characters were
definitely not a good idea.

At the end of the sub in which I add the controls and event
procedures, I close the form on which the controls exist (it is not
the active form) with

DoCmd.Close acForm, frm.Name, acSaveYes

I thought is would save the form without a prompt, but when this line
runs, I am still prompted to save. Any ideas?

I tried this, and found that I was not prompted to save, *provided* that
this form was the only object that needed saving.

--
Dirk Goldgar, MS Access MVP
www.datagnostics.com

(please reply to the newsgroup)

"dchman" wrote in message

One of the controls being added is a subform (along with setting its
ObjectSource), which seems to be the cause of the prompt. If I don't
add the subform, the prompt is not raised. Any ideas how to suppress
the prompt caused by the subform?

You might try explicitly saving the form befor closing it. That is,
instead of this:

DoCmd.Close acForm, frmCurrent.Name, acSaveYes

use this:

DoCmd.Save acForm, frmCurrent.Name
DoCmd.Close acForm, frmCurrent.Name

But I wonder; did you change any of the properties of the subform
control's SourceObject? That would lead to a need to save both forms.

--
Dirk Goldgar, MS Access MVP
www.datagnostics.com

(please reply to the newsgroup)

Yes, in the code when I create the subform, I set its SourceObject property.

I tried the DoCmd.Save earlier in my shotgun approach to solve the issue but
I receive the message "Error 2486, You can't carry out this action at the
present time".

I'd sure welcome any ideas you have.

thanks
--
dchman


"Dirk Goldgar" wrote:

"dchman" wrote in message

One of the controls being added is a subform (along with setting its
ObjectSource), which seems to be the cause of the prompt. If I don't
add the subform, the prompt is not raised. Any ideas how to suppress
the prompt caused by the subform?

You might try explicitly saving the form befor closing it. That is,
instead of this:

DoCmd.Close acForm, frmCurrent.Name, acSaveYes

use this:

DoCmd.Save acForm, frmCurrent.Name
DoCmd.Close acForm, frmCurrent.Name

But I wonder; did you change any of the properties of the subform
control's SourceObject? That would lead to a need to save both forms.

--
Dirk Goldgar, MS Access MVP
www.datagnostics.com

(please reply to the newsgroup)

"dchman" wrote in message

Yes, in the code when I create the subform, I set its SourceObject
property.

But that's a property of the subform control, not of the form that is
its Source Object, so I wouldn't expect it to cause a problem. I was
asking if you changed any properties of the subform control's
source-object *form*.

I tried the DoCmd.Save earlier in my shotgun approach to solve the
issue but I receive the message "Error 2486, You can't carry out this
action at the present time".

What I posted works for me, even if I have a subform control on the form
and change its SourceObject property. There must be more to what you're
doing than you've told us.

I'd sure welcome any ideas you have.

I'd sure welcome a complete post of the all the relevant code.

--
Dirk Goldgar, MS Access MVP
www.datagnostics.com

(please reply to the newsgroup)

its rather sloppy, but here is the main sub that does the work

Private Sub BuildDisplayForm(strPath As String, iOutlineNum As Integer)
'adds controls to form for outline_properity field according to outline_type
On Error GoTo error_BuildDisplayForm
Dim qdf As QueryDef, qdfControls As QueryDef
Dim rs As Recordset, rsFiltered As Recordset, rsControls As Recordset,
rsCurCtrl As Recordset
Dim frm As Form
Dim ctl As Control, ctlLabel As Control, ctlParent As Control
Dim intDataX As Integer, intDataY As Integer
Dim intLabelX As Integer, intLabelY As Integer
Dim strOptTypeName As String, strLabel As String, strValueType As String,
strType As String, strText As String
Dim strFilter As String, strSuffix As String, strParentName As String,
strCaption As String
Dim i As Integer, j As Integer, L As Integer
Dim iLeft As Integer, iTop As Integer, iWidth As Integer, iHeight As Integer
Dim iHP As Integer, iTP As Integer, iLP As Integer, iWP As Integer
Dim iLMargin As Integer, iSep As Integer, iBottom As Integer, iAdj As Integer
Dim iOutlineOrder As Long
Dim strExpr As String
Dim strCtlName As String
Dim strStatus As String
Dim acTypeValue As Long
Dim lngReturn As Long
Dim mdl As Module
Dim strLine As String
Dim strSubFormName As String
strLine = "Call NudgeCurControl(KeyCode)" & vbCrLf & "KeyCode = 0"
iLMargin = 0.25 * 1440
iSep = 0.1 * 1440
i = 0
'this function returns the name of the form to populate
strDisplayFormName = CreateDisplayForm
i = 0
DoCmd.OpenForm strDisplayFormName, acDesign
Set frm = Forms(strDisplayFormName)
Set mdl = frm.Module
frm.Visible = False
frm.Caption = "Path: " & strPath & ",Outline Number: " & CStr(iOutlineNum)
j = frm.Controls.Count - 1
For i = j To 0 Step -1
Select Case frm.Controls(i).ControlType
Case acCommandButton
If (frm.Controls(i).Name "cmdExit") And
(frm.Controls(i).Name "cmdSave") Then
DeleteControl frm.Name, frm.Controls(i).Name
End If
Case acLine, acRectangle
'keep these
Case Else
DeleteControl frm.Name, frm.Controls(i).Name
End Select
Next

'get list of controls on screen for given outline number
Set qdfControls = CurrentDb.QueryDefs("qry_ScreenTypes_forgiven_Outl ineNum")
qdfControls.Parameters("pOutlineNum") = iOutlineNum
Set rsControls = qdfControls.OpenRecordset
If rsControls.EOF And rsControls.BOF Then
'shouldnot happen
Else
Set qdf = CurrentDb.QueryDefs("qryTypeDef")
'loop through controls and put them on display
rsControls.MoveFirst
Do Until rsControls.EOF
strType = rsControls!OutLine_Type
strText = rsControls!OutLine_Properity
iOutlineOrder = rsControls!OutLine_Order

i = 0
qdf.Parameters("TypeName") = strType
Set rs = qdf.OpenRecordset
If rs.EOF And rs.BOF Then
'not a screen type, shouldn't get here

Else
'controls depend upon type
'string types must not have an underscore character
Select Case strType
Case "OptionGrp"
Set rsCurCtrl = GetTypeRS(strType, strText)
'create option group acOptionGroup
strParentName = strType & "_" & CStr(iOutlineOrder) & "_"
strFilter = "Element = 'Left'"
rsCurCtrl.Filter = strFilter
Set rsFiltered = rsCurCtrl.OpenRecordset
iLP = rsFiltered!CurrentValue
strFilter = "Element = 'Top'"
rsCurCtrl.Filter = strFilter
Set rsFiltered = rsCurCtrl.OpenRecordset
iTP = rsFiltered!CurrentValue
strFilter = "Element = 'Width'"
rsCurCtrl.Filter = strFilter
Set rsFiltered = rsCurCtrl.OpenRecordset
iWP = rsFiltered!CurrentValue
Set ctl = CreateControl(frm.Name, acOptionGroup,
acDetail, , "", iLP, iTP, iWP)
iHP = ctl.Height
ctl.Name = strParentName
ctl.DefaultValue = 1
ctl.Tag = "OPTIONGRP"
strExpr = "[Forms]![" & strDisplayFormName & "]![" &
strParentName & "]"
ctl.OnMouseDown = "= SetCurCtrl(" & strExpr & ")"

'optiongroup has one child label
strFilter = "Element = 'Caption_Left'"
rsCurCtrl.Filter = strFilter
Set rsFiltered = rsCurCtrl.OpenRecordset
iLeft = rsFiltered!CurrentValue
strFilter = "Element = 'Caption_Top'"
rsCurCtrl.Filter = strFilter
Set rsFiltered = rsCurCtrl.OpenRecordset
iTop = rsFiltered!CurrentValue
strFilter = "Element = 'Caption_Width'"
rsCurCtrl.Filter = strFilter
Set rsFiltered = rsCurCtrl.OpenRecordset
iWidth = rsFiltered!CurrentValue
strFilter = "Element = 'Caption'"
rsCurCtrl.Filter = strFilter
Set rsFiltered = rsCurCtrl.OpenRecordset
strCaption = rsFiltered!CurrentValue
Set ctlLabel = CreateControl(frm.Name, acLabel, ,
ctl.Name, strCaption, iLeft, iTop)
ctlLabel.Tag = "PARENTCAPTION"
ctlLabel.BackStyle = 1
iWidth = ctlLabel.Width
If iWidth iWP Then
iWP = iWidth + iSep
ctl.Width = iWP
End If

strStatus = "LEFT=" & CStr(iLP) & ",TOP=" & CStr(iTP) &
",WIDTH=" & CStr(iWP)
strStatus = strStatus & ";CAPTION_LEFT=" & CStr(iLeft) &
",CAPTION_TOP=" & CStr(iTP) & ",CAPTION_WIDTH=" & CStr(iWidth)
ctl.StatusBarText = strStatus


Set ctlParent = ctl
'option groups have 10 levels, like opt1..., opt2..., ...
For i = 1 To 10
strFilter = "Element LIKE 'Opt" & CStr(i) & "*'"
rsCurCtrl.Filter = strFilter
Set rsFiltered = rsCurCtrl.OpenRecordset
rsFiltered.MoveFirst
Do Until rsFiltered.EOF
strSuffix = Mid(rsFiltered!Element, 5)
Select Case strSuffix
Case "Left"
iLeft = Val(Nz(rsFiltered!CurrentValue,
0))
If iLeft iLP + iLMargin Then
'left side of option must be greater than left side of group
iLeft = iLP + iLMargin
rsFiltered.Edit
rsFiltered!CurrentValue = iLeft
rsFiltered.Update
End If
Case "Top"
iTop = Val(Nz(rsFiltered!CurrentValue, 0))
If iHeight 0 Then
If iTop iBottom Then 'top of
next group cannot overlap bottom of previous group
iTop = iBottom + iSep
rsFiltered.Edit
rsFiltered!CurrentValue = iTop
rsFiltered.Update
End If
End If
Case "Width"
iWidth = Val(Nz(rsFiltered!CurrentValue,
0))
Case "Caption"
strCaption = Nz(rsFiltered!CurrentValue,
"")
Case Else
End Select
rsFiltered.MoveNext
Loop
If iLeft = 0 Or iTop = 0 Or iWidth = 0 Or strCaption
= "" Then
Exit For
Else
Set ctl = CreateControl(frm.Name,
acOptionButton, acDetail, ctlParent.Name, "", iLeft, iTop, iWidth)
ctl.Name = strType & "_" & CStr(iOutlineOrder)
& "_" & CStr(i)
ctl.OnMouseDown = "= SetCurCtrl(" & strExpr & ")"
lngReturn = mdl.CreateEventProc("KeyDown",
ctl.Name)
mdl.InsertLines lngReturn + 1, strLine
intLabelX = iLeft + iWidth
intLabelY = iTop
Set ctlLabel = CreateControl(frm.Name, acLabel,
, ctl.Name, strCaption, intLabelX, intLabelY)
iWidth = ctlLabel.Width
iHeight = ctl.Height
If (iTop - iTP) + iHeight iHP Then
iHP = iHP + 2 * iHeight
frm.Controls(strParentName).Height = iHP
End If
iBottom = iTop + iHeight
strStatus = "LEFT=" & CStr(iLeft) & ",TOP=" &
CStr(iTop) & ",WIDTH=" & CStr(iWidth)
ctl.StatusBarText = strStatus
End If
Next
rsCurCtrl.Close
Case "TextBox", "ComboBox"
Select Case strType
Case "TextBox"
acTypeValue = acTextBox
Case "ComboBox"
acTypeValue = acComboBox
Case Else

End Select
Set rsCurCtrl = GetTypeRS(strType, strText)
'create control
strParentName = strType & "_" & CStr(iOutlineOrder)
strFilter = "Element = 'Left'"
rsCurCtrl.Filter = strFilter
Set rsFiltered = rsCurCtrl.OpenRecordset
iLP = rsFiltered!CurrentValue
strFilter = "Element = 'Top'"
rsCurCtrl.Filter = strFilter
Set rsFiltered = rsCurCtrl.OpenRecordset
iTP = rsFiltered!CurrentValue
strFilter = "Element = 'Width'"
rsCurCtrl.Filter = strFilter
Set rsFiltered = rsCurCtrl.OpenRecordset
iWP = rsFiltered!CurrentValue
Set ctl = CreateControl(frm.Name, acTypeValue, acDetail,
, "", iLP, iTP, iWP)
iHP = ctl.Height
ctl.Name = strParentName
ctl.Tag = UCase(strType)
strExpr = "[Forms]![" & strDisplayFormName & "]![" &
strParentName & "]"
ctl.OnMouseDown = "= SetCurCtrl(" & strExpr & ")"
lngReturn = mdl.CreateEventProc("KeyDown", ctl.Name)
mdl.InsertLines lngReturn + 1, strLine
'control has one child label
strFilter = "Element = 'Caption_Left'"
rsCurCtrl.Filter = strFilter
Set rsFiltered = rsCurCtrl.OpenRecordset
iLeft = rsFiltered!CurrentValue
strFilter = "Element = 'Caption_Top'"
rsCurCtrl.Filter = strFilter
Set rsFiltered = rsCurCtrl.OpenRecordset
iTop = rsFiltered!CurrentValue
strFilter = "Element = 'Caption_Width'"
rsCurCtrl.Filter = strFilter
Set rsFiltered = rsCurCtrl.OpenRecordset
iWidth = rsFiltered!CurrentValue
strFilter = "Element = 'Caption'"
rsCurCtrl.Filter = strFilter
Set rsFiltered = rsCurCtrl.OpenRecordset
strCaption = rsFiltered!CurrentValue
Set ctlLabel = CreateControl(frm.Name, acLabel, ,
ctl.Name, strCaption, iLeft, iTop)
ctlLabel.Tag = "PARENTCAPTION"
iWidth = ctlLabel.Width
strStatus = "LEFT=" & CStr(iLP) & ",TOP=" & CStr(iTP) &
",WIDTH=" & CStr(iWP)
strStatus = strStatus & ";CAPTION_LEFT=" & CStr(iLeft) &
",CAPTION_TOP=" & CStr(iTP) & ",CAPTION_WIDTH=" & CStr(iWidth)
ctl.StatusBarText = strStatus
Case "OptButton"
acTypeValue = acOptionButton
Set rsCurCtrl = GetTypeRS(strType, strText)
'create control
'option button only has left and top
strParentName = strType & "_" & CStr(iOutlineOrder)
strFilter = "Element = 'Left'"
rsCurCtrl.Filter = strFilter
Set rsFiltered = rsCurCtrl.OpenRecordset
iLP = rsFiltered!CurrentValue
strFilter = "Element = 'Top'"
rsCurCtrl.Filter = strFilter
Set rsFiltered = rsCurCtrl.OpenRecordset
iTP = rsFiltered!CurrentValue
Set ctl = CreateControl(frm.Name, acTypeValue, acDetail,
, "", iLP, iTP)
ctl.Name = strParentName
ctl.Tag = UCase(strType)
iWP = ctl.Width
strExpr = "[Forms]![" & strDisplayFormName & "]![" &
strParentName & "]"
ctl.OnMouseDown = "= SetCurCtrl(" & strExpr & ")"
lngReturn = mdl.CreateEventProc("KeyDown", ctl.Name)
mdl.InsertLines lngReturn + 1, strLine
'control has one child label, with only caption and
width property
'place it to the right of button, same top
iLeft = iLP + iWP + iSep
iTop = iTP
strFilter = "Element = 'Caption_Width'"
rsCurCtrl.Filter = strFilter
Set rsFiltered = rsCurCtrl.OpenRecordset
iWidth = rsFiltered!CurrentValue
strFilter = "Element = 'Caption'"
rsCurCtrl.Filter = strFilter
Set rsFiltered = rsCurCtrl.OpenRecordset
strCaption = rsFiltered!CurrentValue
Set ctlLabel = CreateControl(frm.Name, acLabel, ,
ctl.Name, strCaption, iLeft, iTop)
ctlLabel.Tag = "PARENTCAPTION"
iWidth = ctlLabel.Width
strStatus = "LEFT=" & CStr(iLP) & ",TOP=" & CStr(iTP)
strStatus = strStatus & ";CAPTION_WIDTH=" & CStr(iWidth)
ctl.StatusBarText = strStatus

Case "SubForm"
'position of subform is fixed
iLP = 120
iTP = 2520
iWP = 8400
iHP = 1740
Set ctl = CreateControl(frm.Name, acSubform, acDetail, ,
"", iLP, iTP, iWP, iHP)
ctl.SourceObject = "sfrmSubDisplay"
strSubFormName = ctl.Name
'no positioning of controls, but get labels and col widths
Set rsCurCtrl = GetTypeRS(strType, strText)
'12 text boxes, txt1... to txt12...
'label is txt1ColumnName
'col width is txt1ColumnWidth
For i = 1 To 12
strFilter = "Element LIKE 'txt" & CStr(i) & "*'"
rsCurCtrl.Filter = strFilter
Set rsFiltered = rsCurCtrl.OpenRecordset
rsFiltered.MoveFirst
Do Until rsFiltered.EOF
strSuffix = Mid(rsFiltered!Element, Len(CStr(i))
+ 4)
Select Case strSuffix
Case "ColumnName"
strCaption = Nz(rsFiltered!CurrentValue,
"")
Case "ColumnWidth"
iWidth = Val(Nz(rsFiltered!CurrentValue,
0))
Case Else
End Select
rsFiltered.MoveNext
Loop
'set labels and width per above values
strCtlName = "txt" & CStr(i)

Forms(frm.Name).Form(ctl.Name).Controls(strCtlName ).Width = iWidth
If iWidth = 0 Then

Forms(frm.Name).Form(ctl.Name).Controls(strCtlName ).ColumnHidden = True
End If
strCtlName = "lbltxt" & CStr(i)

Forms(frm.Name).Form(ctl.Name).Controls(strCtlName ).Caption = strCaption
Next
For i = 1 To 4
strFilter = "Element LIKE 'cbo" & CStr(i) & "*'"
rsCurCtrl.Filter = strFilter
Set rsFiltered = rsCurCtrl.OpenRecordset
rsFiltered.MoveFirst
Do Until rsFiltered.EOF
strSuffix = Mid(rsFiltered!Element, Len(CStr(i))
+ 4)
Select Case strSuffix
Case "ColumnName"
strCaption = Nz(rsFiltered!CurrentValue,
"")

Case "ColumnWidth"
iWidth = Val(Nz(rsFiltered!CurrentValue,
0))

Case Else
End Select
rsFiltered.MoveNext
Loop
'set labels and width per above values
strCtlName = "cbo" & CStr(i)

Forms(frm.Name).Form(ctl.Name).Controls(strCtlName ).Width = iWidth
If iWidth = 0 Then

Forms(frm.Name).Form(ctl.Name).Controls(strCtlName ).ColumnHidden = True
End If
strCtlName = "lblcbo" & CStr(i)

Forms(frm.Name).Form(ctl.Name).Controls(strCtlName ).Caption = strCaption
Next
rsCurCtrl.Close
Case Else

End Select
End If
rsControls.MoveNext
Loop
End If
DoCmd.Close acForm, frm.Name, acSaveYes

exit_BuildDisplayForm:

rs.Close
qdf.Close
Set rs = Nothing
Set rsCurCtrl = Nothing
Set qdf = Nothing
Set rsFiltered = Nothing
Set frm = Nothing
Set mdl = Nothing
Exit Sub
error_BuildDisplayForm:
MsgBox "BuildDisplayForm, ioutlineorder=" & CStr(iOutlineOrder) & ";Error "
& Err & " :" & Err.Description
Resume exit_BuildDisplayForm
End Sub


--
dchman


"Dirk Goldgar" wrote:

"dchman" wrote in message

Yes, in the code when I create the subform, I set its SourceObject
property.

But that's a property of the subform control, not of the form that is
its Source Object, so I wouldn't expect it to cause a problem. I was
asking if you changed any properties of the subform control's
source-object *form*.

I tried the DoCmd.Save earlier in my shotgun approach to solve the
issue but I receive the message "Error 2486, You can't carry out this
action at the present time".

What I posted works for me, even if I have a subform control on the form
and change its SourceObject property. There must be more to what you're
doing than you've told us.

I'd sure welcome any ideas you have.

I'd sure welcome a complete post of the all the relevant code.

--
Dirk Goldgar, MS Access MVP
www.datagnostics.com

(please reply to the newsgroup)

"dchman" wrote in message

its rather sloppy, but here is the main sub that does the work

[snipped]

It is as I thought. You have a number of lines like this:

Forms(frm.Name).Form(ctl.Name).Controls(strCtlName ).Width = iWidth

That syntax is rather eccentric; I'd have written the same statement
like this:

frm.Controls(ctl.Name).Form.Controls(strCtlName).W idth = iWidth

.... but it amounts to the same thing: you are changing the property of
a control on the subform. So you aren't changing just one form; you're
changing two, so you have two objects that have to be saved.

I fiddled around with this a bit, and the only way I could find to get
it to close and save both objects without prompting was to turn warnings
off before the save:

'----- start of revised code snippet -----

DoCmd.SetWarnings False
DoCmd.Close acForm, frm.Name, acSaveYes

exit_BuildDisplayForm:

DoCmd.SetWarnings True

'----- end of revised code snippet -----

An alternative would be to open the subform separately, modify it, and
save it independently of the main form.

--
Dirk Goldgar, MS Access MVP
www.datagnostics.com

(please reply to the newsgroup)

thanks for your help and describing my code kindly. I am afraid my Access
education is lacking, although I am acutally signed up for a class next week.

I've cleaned my code up as you suggested. And the simple solution of
turning off the warnings stops the prompt. The subform seems to get saved
anyway, and the app works.


--
dchman


"Dirk Goldgar" wrote:

"dchman" wrote in message

its rather sloppy, but here is the main sub that does the work

[snipped]

It is as I thought. You have a number of lines like this:

Forms(frm.Name).Form(ctl.Name).Controls(strCtlName ).Width = iWidth

That syntax is rather eccentric; I'd have written the same statement
like this:

frm.Controls(ctl.Name).Form.Controls(strCtlName).W idth = iWidth

.... but it amounts to the same thing: you are changing the property of
a control on the subform. So you aren't changing just one form; you're
changing two, so you have two objects that have to be saved.

I fiddled around with this a bit, and the only way I could find to get
it to close and save both objects without prompting was to turn warnings
off before the save:

'----- start of revised code snippet -----

DoCmd.SetWarnings False
DoCmd.Close acForm, frm.Name, acSaveYes

exit_BuildDisplayForm:

DoCmd.SetWarnings True

'----- end of revised code snippet -----

An alternative would be to open the subform separately, modify it, and
save it independently of the main form.

--
Dirk Goldgar, MS Access MVP
www.datagnostics.com

(please reply to the newsgroup)