command-line style commands

[xtra]

Hi Folk

I have written a module that allows you to type a bunch of commands in the
immediate window, for quick access to information when you are creating VB
code. Here it is, it may be helpful to you (I find it pretty fast and
friendly).... Some of it is specific to my database (I left out many as well
which were too specific), so you will have to rewrite it for yours, but you
may find it useful.... Any questions, please ask. Typing Im (false) in the
immediate window will show all the commands - so you only really have to
remember one.

Cheers

- Nicolaas

Public Sub Im(include_explanation As Boolean)
'explains all the immediate commands in more detail.
''on error GoTo er
Dim MDL As Module
Dim S As String
Dim Itm As Variant
'-
Call AllProcs("010 __________________________ IMMEDIATE WINDOW
COMMANDS", 0)
Call imMLet("0", include_explanation)
xt:
Exit Sub
er:
Resume 0
End Sub
Public Sub imFldNs(Tbln As String)
'lists all the field names for a table
''on error GoTo er
'-
Dim TBL As TableDef
Dim FLD As Field
Dim Dbs As DAO.Database
'-
Set Dbs = CurrentDb
Set TBL = Dbs.TableDefs(Tbln)
For Each FLD In TBL.Fields
Debug.Print FLD.NAME, FLD.type, FLD.Size
Next FLD
xt:
Set Dbs = Nothing
Set TBL = Nothing
Exit Sub
er:
MsgBox ERROR$
Resume xt
End Sub
Public Sub ImSqlE(S As String)
'puts the S string into a temporary query and opens it to show you what it
looks like
''on error GoTo er
'-
'on error Resume Next
DoCmd.DeleteObject acQuery, Q
'on error GoTo er
CurrentDb.CreateQueryDef Q, S
DoCmd.OpenQuery Q, acViewDesign, acEdit
xt:
Exit Sub
er:
MsgBox ERROR$
Resume xt
End Sub

Public Function ImOpenO(ObjN As String, Optional ObjT As Long)
'puts the S string into a temporary query and opens it to show you what it
looks like
'note that you need to swith windows to see the query (you will return to
the immediate window after running this function).
'on error GoTo er
Dim ObjC As Long 'object count
'-
If Nz(ObjT, 0) <> 0 Then
ObjC = 1
Else
ObjC = eCount("[ID]", "[msysobjects]", "[msysobjects]![name]='" & ObjN
& "'")
ObjT = eMin("[type]", "[msysobjects]", "[msysobjects]![name]='" & ObjN
& "'")
End If
Select Case ObjC
Case Is < 1
MsgBox "object does not exist"
Case Is > 1
MsgBox "there is more than one object with this name"
Case 1
Call OpenObject(ObjN, ObjT)
End Select
xt:
Exit Function
er:
MsgBox ERROR$
Resume xt
End Function

Public Function ImSTF(FrmN As String, FrmT As Byte)
'standardizes a form - useful if you are building a new form - it adds all
the standard items, etc...
'the form should be closed to run this function
'frmT = 0 ... -EDI
'frmT = 1 ... -LIS
'frmT = 2 ... -SUB
'frmT = 3 .... -X
Dim FRM As Form
Dim Ctl As Control
'-
If IsLoaded(FrmN) = True Then
MsgBox "Please close form first - this is to prevent from overriding
any chances that you may not have saved yet."
End If
DoCmd.CopyObject , "FORM10", acForm, FrmN
Debug.Print "a backup of the form has been made as FORM10"
DoCmd.OpenForm FrmN, acDesign, , , , acHidden
Set FRM = Forms(FrmN)
With FRM
Call ImSTX("Please enter form caption", "caption", FRM)
Call ImSTX("Please enter RecordSource", "RecordSource", FRM)
.Tag = Left(FRM.RecordSource, 5)
.AllowFilters = True
.DefaultView = IIf(FrmT > 1, 1, FrmT)
.ViewsAllowed = 1
.AllowFormView = True
.AllowDatasheetView = False
.AllowPivotTableView = False
.AllowPivotChartView = True
.AllowEditing = False
.AllowEdits = True
.AllowDeletions = True
.AllowAdditions = True
.DataEntry = False
.RecordsetType = IIf(FrmT = 3, 1, 0)
.RecordLocks = 0
.ScrollBars = 3
.RecordSelectors = False
.NavigationButtons = True
.DividingLines = False
.AutoResize = False
.AutoCenter = False
.PopUp = False
.Modal = False
.BorderStyle = 2
.ControlBox = True
.MinButton = False
.MaxButton = True
.MinMaxButtons = 2
.CloseButton = True
.WhatsThisButton = False
.Width = TW(20)
.PictureTiling = False
.Cycle = 0
.GridX = 4
.GridY = 4
.LayoutForPrint = False
.FastLaserPrinting = True
.FetchDefaults = True
End With
'- adjust controls
For Each Ctl In FRM.Controls
Call ImSTX("are you happy with the name of the control: " &
Format(Ctl.NAME, ">"), "name", Ctl)
Select Case Ctl.NAME
Case "ID", "IDR", "IDL"
Ctl.Visible = False
Ctl.Width = TW(0.25)
Ctl.BackColor = 13408767
Ctl.BackStyle = 1
GoTo ctl_looper
Case Else
'do nothing
End Select
Select Case Ctl.ControlType
Case acListBox, acComboBox
With Ctl
.DecimalPlaces = 255 '2
.RowSourceType = "Table/Query" '8
Call ImSTX("What should be the controlsource for control: "
& Format(Ctl.NAME, ">"), "controlsource", Ctl)
Call ImSTX("What is the status bar text for control: " &
Format(Ctl.NAME, ">"), "statusbartext", Ctl)
.ControlTipText = .StatusBarText
.ColumnCount = 2 '2
.ColumnHeads = False '11
.ColumnWidths = "0;" & TW(12)
.BoundColumn = 1 '3
.ListRows = 12 '2
.ListWidth = TW(12)
.LimitToList = True '11
.AutoExpand = True '11
.IMEHold = False '11
.IMEMode = 0 '2
.IMESentenceMode = 3 '2
.Visible = True '11
.DisplayWhen = 0 '2
.Enabled = True '11
.Locked = False '11
.AllowAutoCorrect = True '11
.TabStop = True '11
.Height = 284 '2
.BackStyle = 0 '2
.BackColor = 52479 '3
.SpecialEffect = 0 '2
.BorderStyle = 1 '2
.OldBorderStyle = 1 '2
.BorderColor = 52479 '3
.BorderWidth = 0 '2
.BorderLineStyle = 0 '2
.ForeColor = 0 '3
.FontName = "Trebuchet MS" '8
.FontSize = 8 '2
.FontWeight = 400 '2
.FontItalic = False '11
.FontUnderline = False '11
.TextFontCharSet = 0 '2
.TextAlign = 1 '2
.FontBold = 0 '2
.HelpContextId = 0 '3
.ColumnWidth = -1 '2
.ColumnOrder = 0 '2
.ColumnHidden = False '11
.Section = 0 '2
End With
Case acTextBox
With Ctl
Call ImSTX("What should be the controlsource for control " &
Format(Ctl.NAME, ">"), "controlsource", Ctl)
Call ImSTX("What is the status bar text for control: " &
Format(Ctl.NAME, ">"), "statusbartext", Ctl)
.ControlTipText = .StatusBarText
.DecimalPlaces = 255 '2
.IMEHold = False '11
.IMEMode = 0 '2
.IMESentenceMode = 3 '2
.EnterKeyBehavior = False '11
.AllowAutoCorrect = True '11
.Visible = True '11
.DisplayWhen = 0 '2
.Vertical = False '11
.AsianLineBreak = True '11
.Enabled = True '11
.Locked = False '11
.FilterLookup = 1 '2
.AutoTab = False '11
.TabStop = True '11
.ScrollBars = 0 '2
.CanGrow = True '11
.CanShrink = False '11
.BackStyle = 0 '2
.BackColor = 16777215 '3
.SpecialEffect = 0 '2
.BorderStyle = 1 '2
.OldBorderStyle = 1 '2
.BorderColor = 52479 '3
.BorderWidth = 0 '2
.BorderLineStyle = 0 '2
.ForeColor = 0 '3
.FontName = "Trebuchet MS" '8
.FontSize = 8 '2
.FontWeight = 400 '2
.FontItalic = False '11
.FontUnderline = False '11
.TextFontCharSet = 0 '2
.TextAlign = 1 '2
.FontBold = 0 '2
.HelpContextId = 0 '3
.ColumnWidth = -1 '2
.ColumnOrder = 0 '2
.ColumnHidden = False '11
End With
Case acLabel
With Ctl
Call ImSTX("caption for the following label: " &
Format(Ctl.NAME, ">"), "caption", Ctl)
.Visible = True '11
.DisplayWhen = 0 '2
.Vertical = False '11
.BackStyle = 1 '2
.BackColor = 8870738 '3
.SpecialEffect = 0 '2
.BorderStyle = 0 '2
.OldBorderStyle = 0 '2
.BorderColor = 8454143 '3
.BorderWidth = 1 '2
.BorderLineStyle = 0 '2
.ForeColor = 12632256 '3
.FontName = "Trebuchet MS" '8
.FontSize = 8 '2
.FontWeight = 400 '2
.FontItalic = False '11
.FontUnderline = False '11
.TextFontCharSet = 0 '2
.TextAlign = 2 '2
.FontBold = 0 '2
Call ImSTX("What is the ControlTipText for the following
label: " & Format(Ctl.NAME, ">"), "ControlTipText", Ctl)
.HelpContextId = 0 '3
.ReadingOrder = 0 '2
.NumeralShapes = 0 '2
.LeftMargin = TW(0.053)
.TopMargin = TW(0.053)
.RightMargin = TW(0.053)
.BottomMargin = TW(0.053)
.LineSpacing = TW(0.053)
End With
End Select
Select Case FrmT
Case 0
Ctl.Height = TW(1)
Case 1, 2
Ctl.Height = TW(0.5)
Ctl.top = TW(0.25)
End Select
ctl_looper:
Next Ctl
DoCmd.close acForm, FrmN, acSaveYes
DoCmd.OpenForm FrmN, acDesign, , , , acWindowNormal
xt:
Exit Function
er:
MsgBox ERROR$
Resume xt
End Function

Private Function ImSTX(InputQuestion As String, ppt As String, Obj As
Object)
'helps with the imSTF function to set certain string using an 'optional'
input box
'the Obj can be a control or a form
''on error goto err
Dim S As String
Const NC = "{do not change}"
Dim P As String
'- get current entry
P = Obj.Properties(ppt)
If Nz(P, "") = "" Then
P = NC
End If
'- ask for input
S = InputBox(InputQuestion, InputQuestion, P, 50, 50)
If S <> P Then
Obj.Properties(ppt) = S
End If
xt:
Exit Function
er:
MsgBox ERROR$
Resume xt
End Function
Public Function imopenF(FunctionName As String)
'opens a procedure
DoCmd.OpenModule , FunctionName
End Function

Public Function imSPRO()
'writes the skeleton of a standard procedure to the immediate window so that
you can copy it for a new function
Const SEP = "'-"
Debug.Print "function New () as boolean"
Debug.Print " on error goto er"
Debug.Print SEP
Debug.Print " Dim TblN as string"
Debug.Print " Dim Ctl as Control"
Debug.Print " Dim CtlN as string"
Debug.Print " Dim Frm as Form"
Debug.Print " Dim FrmN as string"
Debug.Print " Dim x,y,z as long"
Debug.Print " Dim Dbs as dao.database"
Debug.Print " Dim Rst as dao.recordset"
Debug.Print " Dim SqlS as string"
Debug.Print SEP
Debug.Print " "
Debug.Print " "
Debug.Print SEP
Debug.Print "xt:"
Debug.Print " exit function"
Debug.Print "er:"
Debug.Print " resume xt"
Debug.Print "end function"
End Function
Public Function AllProcs(ByVal MdlN As String, Optional ObjT As Byte)
'lists all the procedures in a module
'if objt = 0 then mdln = is a standard module
'if objt = 1 then MdlN is a form
'if objt = 2 then MdlN is a report
''on error GoTo er
'-
Dim MDL As Module
Dim count As Long
Dim CountDecl As Long
Dim i As Long
Dim ProcName As String
Dim aProcNames() As String
Dim intI As Integer
Dim MSG As String
Dim R As Long
Dim ProType As Long
Dim ProNote As String
Dim j As Integer
Dim L As Integer
Dim MdlN2 As String
'- delete old data
FRUNSQL ("delete [D-MDL].* from [D-MDL] where [D-MDL]![D] = '" & MdlN &
"';")
'- open a form to help with the transition of data
DoCmd.OpenForm "T-TEM-DEV", acNormal, , , acFormEdit, acHidden
'-establish the type of modules
ObjT = ObjT + 0
Select Case ObjT
Case 0
DoCmd.OpenModule MdlN ' Open specified Module object
Set MDL = Modules(MdlN) ' Return reference to Module object.
MdlN2 = MdlN
Case 1 'FORM
DoCmd.OpenForm MdlN, acDesign, , , , acHidden
If Not Forms(MdlN).HasModule Then GoTo xt
Set MDL = Forms(MdlN).Module
MdlN2 = " FORMS " & MdlN
Case 2
DoCmd.OpenReport MdlN, acDesign, , , acHidden
If Not Reports(MdlN).HasModule Then GoTo xt
Set MDL = Reports(MdlN).Module
MdlN2 = " REPORTS " & MdlN
End Select
count = MDL.CountOfLines ' Count lines in module.
CountDecl = MDL.CountOfDeclarationLines ' Count lines in Declaration
section in module.
ProcName = MDL.ProcOfLine(CountDecl + 1, R) ' Determine name of first
procedure.
Debug.Print ProcName
If Nz(ProcName, "") = "" Then GoTo xt
i = CountDecl + 1
GoSub register
For i = CountDecl + 1 To count ' Determine procedure name for each line
after declarations.
If ProcName <> MDL.ProcOfLine(i, R) Then ' Compare procedure
name with ProcOfLine property value.
ProcName = MDL.ProcOfLine(i, R)
GoSub register
End If
Next i
DoCmd.close acForm, "T-TEM-DEV", acSaveNo
Select Case ObjT
Case 0
'on error Resume Next
DoCmd.close acModule, MdlN, acSaveNo
'on error GoTo 0
Case 1
DoCmd.close acForm, MdlN, acSaveNo
Case 2
DoCmd.close acReport, MdlN, acSaveNo
End Select
xt:
Exit Function
er:
MsgBox ERROR$
Resume Next
register:
ProType = R
j = MDL.ProcBodyLine(ProcName, R)
L = j - i
If L < 7 Then L = 7
If i + L > count Then L = 1
ProNote = MDL.Lines(i, L)
Forms("T-TEM-DEV").Controls("1") = ProNote
FRUNSQL ("INSERT INTO [D-MDL] ( [D], [Dc], [D-MDT-ID], [MEM] )
SELECT '" & MdlN2 & "' AS N, '" & ProcName & "' AS P, " & ProType & " AS T,
Forms![T-TEM-DEV]![1] AS M;")
Return

End Function

[John Smith]

Awesome Dude!
\;
"xtra" <wi**********@hottermail.com> wrote in message
news:wO*****************@news.xtra.co.nz...

Hi Folk

I have written a module that allows you to type a bunch of commands in the
immediate window, for quick access to information when you are creating VB
code. Here it is, it may be helpful to you (I find it pretty fast and
friendly).... Some of it is specific to my database (I left out many as
well
which were too specific), so you will have to rewrite it for yours, but
you
may find it useful.... Any questions, please ask. Typing Im (false) in
the
immediate window will show all the commands - so you only really have to
remember one.

Cheers

- Nicolaas

Public Sub Im(include_explanation As Boolean)
'explains all the immediate commands in more detail.
''on error GoTo er
Dim MDL As Module
Dim S As String
Dim Itm As Variant
'-
Call AllProcs("010 __________________________ IMMEDIATE WINDOW
COMMANDS", 0)
Call imMLet("0", include_explanation)
xt:
Exit Sub
er:
Resume 0
End Sub
Public Sub imFldNs(Tbln As String)
'lists all the field names for a table
''on error GoTo er
'-
Dim TBL As TableDef
Dim FLD As Field
Dim Dbs As DAO.Database
'-
Set Dbs = CurrentDb
Set TBL = Dbs.TableDefs(Tbln)
For Each FLD In TBL.Fields
Debug.Print FLD.NAME, FLD.type, FLD.Size
Next FLD
xt:
Set Dbs = Nothing
Set TBL = Nothing
Exit Sub
er:
MsgBox ERROR$
Resume xt
End Sub
Public Sub ImSqlE(S As String)
'puts the S string into a temporary query and opens it to show you what it
looks like
''on error GoTo er
'-
'on error Resume Next
DoCmd.DeleteObject acQuery, Q
'on error GoTo er
CurrentDb.CreateQueryDef Q, S
DoCmd.OpenQuery Q, acViewDesign, acEdit
xt:
Exit Sub
er:
MsgBox ERROR$
Resume xt
End Sub

Public Function ImOpenO(ObjN As String, Optional ObjT As Long)
'puts the S string into a temporary query and opens it to show you what it
looks like
'note that you need to swith windows to see the query (you will return to
the immediate window after running this function).
'on error GoTo er
Dim ObjC As Long 'object count
'-
If Nz(ObjT, 0) <> 0 Then
ObjC = 1
Else
ObjC = eCount("[ID]", "[msysobjects]", "[msysobjects]![name]='" &
ObjN
& "'")
ObjT = eMin("[type]", "[msysobjects]", "[msysobjects]![name]='" &
ObjN
& "'")
End If
Select Case ObjC
Case Is < 1
MsgBox "object does not exist"
Case Is > 1
MsgBox "there is more than one object with this name"
Case 1
Call OpenObject(ObjN, ObjT)
End Select
xt:
Exit Function
er:
MsgBox ERROR$
Resume xt
End Function

Public Function ImSTF(FrmN As String, FrmT As Byte)
'standardizes a form - useful if you are building a new form - it adds all
the standard items, etc...
'the form should be closed to run this function
'frmT = 0 ... -EDI
'frmT = 1 ... -LIS
'frmT = 2 ... -SUB
'frmT = 3 .... -X
Dim FRM As Form
Dim Ctl As Control
'-
If IsLoaded(FrmN) = True Then
MsgBox "Please close form first - this is to prevent from
overriding
any chances that you may not have saved yet."
End If
DoCmd.CopyObject , "FORM10", acForm, FrmN
Debug.Print "a backup of the form has been made as FORM10"
DoCmd.OpenForm FrmN, acDesign, , , , acHidden
Set FRM = Forms(FrmN)
With FRM
Call ImSTX("Please enter form caption", "caption", FRM)
Call ImSTX("Please enter RecordSource", "RecordSource", FRM)
.Tag = Left(FRM.RecordSource, 5)
.AllowFilters = True
.DefaultView = IIf(FrmT > 1, 1, FrmT)
.ViewsAllowed = 1
.AllowFormView = True
.AllowDatasheetView = False
.AllowPivotTableView = False
.AllowPivotChartView = True
.AllowEditing = False
.AllowEdits = True
.AllowDeletions = True
.AllowAdditions = True
.DataEntry = False
.RecordsetType = IIf(FrmT = 3, 1, 0)
.RecordLocks = 0
.ScrollBars = 3
.RecordSelectors = False
.NavigationButtons = True
.DividingLines = False
.AutoResize = False
.AutoCenter = False
.PopUp = False
.Modal = False
.BorderStyle = 2
.ControlBox = True
.MinButton = False
.MaxButton = True
.MinMaxButtons = 2
.CloseButton = True
.WhatsThisButton = False
.Width = TW(20)
.PictureTiling = False
.Cycle = 0
.GridX = 4
.GridY = 4
.LayoutForPrint = False
.FastLaserPrinting = True
.FetchDefaults = True
End With
'- adjust controls
For Each Ctl In FRM.Controls
Call ImSTX("are you happy with the name of the control: " &
Format(Ctl.NAME, ">"), "name", Ctl)
Select Case Ctl.NAME
Case "ID", "IDR", "IDL"
Ctl.Visible = False
Ctl.Width = TW(0.25)
Ctl.BackColor = 13408767
Ctl.BackStyle = 1
GoTo ctl_looper
Case Else
'do nothing
End Select
Select Case Ctl.ControlType
Case acListBox, acComboBox
With Ctl
.DecimalPlaces = 255 '2
.RowSourceType = "Table/Query" '8
Call ImSTX("What should be the controlsource for control: "
& Format(Ctl.NAME, ">"), "controlsource", Ctl)
Call ImSTX("What is the status bar text for control: " &
Format(Ctl.NAME, ">"), "statusbartext", Ctl)
.ControlTipText = .StatusBarText
.ColumnCount = 2 '2
.ColumnHeads = False '11
.ColumnWidths = "0;" & TW(12)
.BoundColumn = 1 '3
.ListRows = 12 '2
.ListWidth = TW(12)
.LimitToList = True '11
.AutoExpand = True '11
.IMEHold = False '11
.IMEMode = 0 '2
.IMESentenceMode = 3 '2
.Visible = True '11
.DisplayWhen = 0 '2
.Enabled = True '11
.Locked = False '11
.AllowAutoCorrect = True '11
.TabStop = True '11
.Height = 284 '2
.BackStyle = 0 '2
.BackColor = 52479 '3
.SpecialEffect = 0 '2
.BorderStyle = 1 '2
.OldBorderStyle = 1 '2
.BorderColor = 52479 '3
.BorderWidth = 0 '2
.BorderLineStyle = 0 '2
.ForeColor = 0 '3
.FontName = "Trebuchet MS" '8
.FontSize = 8 '2
.FontWeight = 400 '2
.FontItalic = False '11
.FontUnderline = False '11
.TextFontCharSet = 0 '2
.TextAlign = 1 '2
.FontBold = 0 '2
.HelpContextId = 0 '3
.ColumnWidth = -1 '2
.ColumnOrder = 0 '2
.ColumnHidden = False '11
.Section = 0 '2
End With
Case acTextBox
With Ctl
Call ImSTX("What should be the controlsource for control "
&
Format(Ctl.NAME, ">"), "controlsource", Ctl)
Call ImSTX("What is the status bar text for control: " &
Format(Ctl.NAME, ">"), "statusbartext", Ctl)
.ControlTipText = .StatusBarText
.DecimalPlaces = 255 '2
.IMEHold = False '11
.IMEMode = 0 '2
.IMESentenceMode = 3 '2
.EnterKeyBehavior = False '11
.AllowAutoCorrect = True '11
.Visible = True '11
.DisplayWhen = 0 '2
.Vertical = False '11
.AsianLineBreak = True '11
.Enabled = True '11
.Locked = False '11
.FilterLookup = 1 '2
.AutoTab = False '11
.TabStop = True '11
.ScrollBars = 0 '2
.CanGrow = True '11
.CanShrink = False '11
.BackStyle = 0 '2
.BackColor = 16777215 '3
.SpecialEffect = 0 '2
.BorderStyle = 1 '2
.OldBorderStyle = 1 '2
.BorderColor = 52479 '3
.BorderWidth = 0 '2
.BorderLineStyle = 0 '2
.ForeColor = 0 '3
.FontName = "Trebuchet MS" '8
.FontSize = 8 '2
.FontWeight = 400 '2
.FontItalic = False '11
.FontUnderline = False '11
.TextFontCharSet = 0 '2
.TextAlign = 1 '2
.FontBold = 0 '2
.HelpContextId = 0 '3
.ColumnWidth = -1 '2
.ColumnOrder = 0 '2
.ColumnHidden = False '11
End With
Case acLabel
With Ctl
Call ImSTX("caption for the following label: " &
Format(Ctl.NAME, ">"), "caption", Ctl)
.Visible = True '11
.DisplayWhen = 0 '2
.Vertical = False '11
.BackStyle = 1 '2
.BackColor = 8870738 '3
.SpecialEffect = 0 '2
.BorderStyle = 0 '2
.OldBorderStyle = 0 '2
.BorderColor = 8454143 '3
.BorderWidth = 1 '2
.BorderLineStyle = 0 '2
.ForeColor = 12632256 '3
.FontName = "Trebuchet MS" '8
.FontSize = 8 '2
.FontWeight = 400 '2
.FontItalic = False '11
.FontUnderline = False '11
.TextFontCharSet = 0 '2
.TextAlign = 2 '2
.FontBold = 0 '2
Call ImSTX("What is the ControlTipText for the
following
label: " & Format(Ctl.NAME, ">"), "ControlTipText", Ctl)
.HelpContextId = 0 '3
.ReadingOrder = 0 '2
.NumeralShapes = 0 '2
.LeftMargin = TW(0.053)
.TopMargin = TW(0.053)
.RightMargin = TW(0.053)
.BottomMargin = TW(0.053)
.LineSpacing = TW(0.053)
End With
End Select
Select Case FrmT
Case 0
Ctl.Height = TW(1)
Case 1, 2
Ctl.Height = TW(0.5)
Ctl.top = TW(0.25)
End Select
ctl_looper:
Next Ctl
DoCmd.close acForm, FrmN, acSaveYes
DoCmd.OpenForm FrmN, acDesign, , , , acWindowNormal
xt:
Exit Function
er:
MsgBox ERROR$
Resume xt
End Function

Private Function ImSTX(InputQuestion As String, ppt As String, Obj As
Object)
'helps with the imSTF function to set certain string using an 'optional'
input box
'the Obj can be a control or a form
''on error goto err
Dim S As String
Const NC = "{do not change}"
Dim P As String
'- get current entry
P = Obj.Properties(ppt)
If Nz(P, "") = "" Then
P = NC
End If
'- ask for input
S = InputBox(InputQuestion, InputQuestion, P, 50, 50)
If S <> P Then
Obj.Properties(ppt) = S
End If
xt:
Exit Function
er:
MsgBox ERROR$
Resume xt
End Function
Public Function imopenF(FunctionName As String)
'opens a procedure
DoCmd.OpenModule , FunctionName
End Function

Public Function imSPRO()
'writes the skeleton of a standard procedure to the immediate window so
that
you can copy it for a new function
Const SEP = "'-"
Debug.Print "function New () as boolean"
Debug.Print " on error goto er"
Debug.Print SEP
Debug.Print " Dim TblN as string"
Debug.Print " Dim Ctl as Control"
Debug.Print " Dim CtlN as string"
Debug.Print " Dim Frm as Form"
Debug.Print " Dim FrmN as string"
Debug.Print " Dim x,y,z as long"
Debug.Print " Dim Dbs as dao.database"
Debug.Print " Dim Rst as dao.recordset"
Debug.Print " Dim SqlS as string"
Debug.Print SEP
Debug.Print " "
Debug.Print " "
Debug.Print SEP
Debug.Print "xt:"
Debug.Print " exit function"
Debug.Print "er:"
Debug.Print " resume xt"
Debug.Print "end function"
End Function
Public Function AllProcs(ByVal MdlN As String, Optional ObjT As Byte)
'lists all the procedures in a module
'if objt = 0 then mdln = is a standard module
'if objt = 1 then MdlN is a form
'if objt = 2 then MdlN is a report
''on error GoTo er
'-
Dim MDL As Module
Dim count As Long
Dim CountDecl As Long
Dim i As Long
Dim ProcName As String
Dim aProcNames() As String
Dim intI As Integer
Dim MSG As String
Dim R As Long
Dim ProType As Long
Dim ProNote As String
Dim j As Integer
Dim L As Integer
Dim MdlN2 As String
'- delete old data
FRUNSQL ("delete [D-MDL].* from [D-MDL] where [D-MDL]![D] = '" & MdlN &
"';")
'- open a form to help with the transition of data
DoCmd.OpenForm "T-TEM-DEV", acNormal, , , acFormEdit, acHidden
'-establish the type of modules
ObjT = ObjT + 0
Select Case ObjT
Case 0
DoCmd.OpenModule MdlN ' Open specified Module object
Set MDL = Modules(MdlN) ' Return reference to Module object.
MdlN2 = MdlN
Case 1 'FORM
DoCmd.OpenForm MdlN, acDesign, , , , acHidden
If Not Forms(MdlN).HasModule Then GoTo xt
Set MDL = Forms(MdlN).Module
MdlN2 = " FORMS " & MdlN
Case 2
DoCmd.OpenReport MdlN, acDesign, , , acHidden
If Not Reports(MdlN).HasModule Then GoTo xt
Set MDL = Reports(MdlN).Module
MdlN2 = " REPORTS " & MdlN
End Select
count = MDL.CountOfLines ' Count lines in module.
CountDecl = MDL.CountOfDeclarationLines ' Count lines in Declaration
section in module.
ProcName = MDL.ProcOfLine(CountDecl + 1, R) ' Determine name of first
procedure.
Debug.Print ProcName
If Nz(ProcName, "") = "" Then GoTo xt
i = CountDecl + 1
GoSub register
For i = CountDecl + 1 To count ' Determine procedure name for each line
after declarations.
If ProcName <> MDL.ProcOfLine(i, R) Then ' Compare procedure
name with ProcOfLine property value.
ProcName = MDL.ProcOfLine(i, R)
GoSub register
End If
Next i
DoCmd.close acForm, "T-TEM-DEV", acSaveNo
Select Case ObjT
Case 0
'on error Resume Next
DoCmd.close acModule, MdlN, acSaveNo
'on error GoTo 0
Case 1
DoCmd.close acForm, MdlN, acSaveNo
Case 2
DoCmd.close acReport, MdlN, acSaveNo
End Select
xt:
Exit Function
er:
MsgBox ERROR$
Resume Next
register:
ProType = R
j = MDL.ProcBodyLine(ProcName, R)
L = j - i
If L < 7 Then L = 7
If i + L > count Then L = 1
ProNote = MDL.Lines(i, L)
Forms("T-TEM-DEV").Controls("1") = ProNote
FRUNSQL ("INSERT INTO [D-MDL] ( [D], [Dc], [D-MDT-ID], [MEM] )
SELECT '" & MdlN2 & "' AS N, '" & ProcName & "' AS P, " & ProType & " AS
T,
Forms![T-TEM-DEV]![1] AS M;")
Return

End Function