On Error GoTo RebuildSubForm_Error
'
'---------------------------------------------------------------------------------------
' Procedure : RebuildSubForm
'
' DateTime : 14/05/2023
'
' Author : Nick Boddington
'
' Purpose :
'
'---------------------------------------------------------------------------------------
' AMENDMENTS
'---------------------------------------------------------------------------------------
' Date | Author | Details of change
'---------------------------------------------------------------------------------------
'
'---------------------------------------------------------------------------------------
'------------------------------------------------
'Access Variables
'------------------------------------------------
Dim frm As Form
Dim ctl As control
Dim lbl As Label
Dim txt As TextBox
Dim obj As Object
'------------------------------------------------
'DAO Variables
'------------------------------------------------
Dim rstXT As DAO.Recordset
Dim dbs As DAO.Database
Dim qdf As DAO.QueryDef
'------------------------------------------------
'DAO Variables
'------------------------------------------------
Dim intCount As Integer
Dim strDescField As String
Dim lngEndMS As Long
Dim lngStartMS As Long
Dim intControlCount As Integer
'
'------------------------------------------------
'Remove existing controls from subform
'in reverse order
'------------------------------------------------
lngStartMS = timeGetTime
Set dbs = CurrentDb
DoCmd.OpenForm strSubForm, acDesign, , , , acHidden
Set frm = Forms(strSubForm)
intControlCount = frm.Controls.count
For intCount = frm.Controls.count - 1 To 0 Step -1
DeleteControl frm.Name, frm.Controls(intCount).Name
Next
lngEndMS = timeGetTime
gastrTimings(intTimingCount) = intTimingCount + 1 & " ; Remove control from crosstab form : " & strSubForm & ";" & lngEndMS - lngStartMS & ";" & intControlCount
intTimingCount = intTimingCount + 1
'------------------------------------------------
'Default datasheet settings
'------------------------------------------------
lngStartMS = timeGetTime
With frm
.DatasheetFontName = "SegoeUI"
.DatasheetFontHeight = 10
.RowHeight = 300
'.Properties("TotalsRow") = True
End With
'------------------------------------------------
'Add controls to subform based on the crosstab query
'------------------------------------------------
lngStartMS = timeGetTime
Set dbs = CurrentDb
Set frm = Forms(strSubForm)
Set rstXT = dbs.OpenRecordset(strXTabQuery, dbOpenDynaset)
For intCount = 0 To rstXT.Fields.count - 1
If rstXT.Fields(intCount).Name <> "Sequence" Then
Set txt = CreateControl(frm.Name, acTextBox, acDetail)
txt.ControlSource = rstXT.Fields(intCount).Name
txt.Name = "txt" & rstXT.Fields(intCount).Name
If rstXT.Fields(intCount).Name = strDescField Then
txt.Tag = "Descfield"
End If
rstXT.Fields(intCount).Properties("AggregateType") = 0
Set lbl = CreateControl(frm.Name, acLabel, acDetail, txt.Name)
lbl.Caption = rstXT.Fields(intCount).Name
End If
Next
rstXT.Close
Set rstXT = Nothing
'
'------------------------------------------------
'Add AggregateType to querydef columns
'------------------------------------------------
If blnAddTotals = True Then
Set qdf = dbs.QueryDefs("qselBudgetXT")
qdf.Properties("TotalsRow") = True
For intCount = 2 To qdf.Fields.count - 1
qdf.Fields(intCount).Properties("AggregateType") = 0
Next
qdf.Close
End If
lngEndMS = timeGetTime
gastrTimings(intTimingCount) = intTimingCount + 1 & " ; Add controls to crosstab form : " & strSubForm & ";" & lngEndMS - lngStartMS & ";" & frm.Controls.count
intTimingCount = intTimingCount + 1
'------------------------------------------------
'Format controls
'------------------------------------------------
For Each ctl In frm.Controls
If TypeOf ctl Is TextBox Then
Set txt = ctl
If txt.Tag <> "Descfield" Then
txt.ColumnWidth = 3 * gcintTwipsPerCm
txt.Format = "£#,##0.00"
txt.TextAlign = 2
txt.FontName = "Segoe UI"
txt.FontSize = 10
Else
txt.ColumnWidth = 5 * gcintTwipsPerCm
End If
If HasProperty(ctl, "AggregateType") = False Then
Set obj = ctl
obj.Properties.Append dbs.CreateProperty("AggregateType", dbLong, acAggregateSum)
Else
ctl.Properties("AggregateType") = acAggregateSum
End If
'On Error Resume Next
'ctl.Properties("AggregateType") = 0
End If
Next
'
'If HasProperty(frm, "TotalsRow") = False Then
' Set obj = frm
' obj.Properties.Append dbs.CreateProperty("TotalsRow", dbBoolean, True)
'End If
lngEndMS = timeGetTime
gastrTimings(intTimingCount) = intTimingCount + 1 & " ; Format controls on crosstab form : " & strSubForm & ";" & lngEndMS - lngStartMS & ";" & frm.Controls.count
intTimingCount = intTimingCount + 1
frm.sou
DoCmd.Close acForm, frm.Name, acSaveYes
'
'
Exit_RebuildSubForm:
Exit Sub
RebuildSubForm_Error:
If Err.Number < 0 Then
'For errors being passed here from a subsequent proc
Err.Raise vbObjectError + 2, "", Err.Description & vbNewLine & "Passed to module/proc : modFunctions/RebuildSubForm"
Else
'For errors raised in this proc
Err.Raise vbObjectError + 2, "", "Error " & Err.Number & " : " & Err.Description & vbCrLf & "Raised in module/proc : modFunctions/RebuildSubForm"
End If
Resume Exit_RebuildSubForm
'
End Sub