E
eschloss
Access 2003
I created a form(A) which is used as a barchart. I have placed this form(A)
as a subform in a report, but it only displays a blank page. There is
nothing in this report except for this subform in the Detail section.
The form(A) is fed date information by another form(B) which currently only
handles the selection of a date range. I suspect, from posts and Help, that
I need to specify the "Link Child/Master Fields" of the subform within the
report. However, I do not know how to proceed because form(A) uses multiple
record sources. Are the blank "Link Child/Master Fields" most likely my
issue?
Below is the code for form(A). It's lengthy, sorry.
Private Sub Form_Load()
'Add error code
Dim db As dao.Database
Dim rst As dao.Recordset
Dim qdf As dao.QueryDef
Dim rst_count_areas As Integer
Dim rst_count_names As Integer
Dim sql As String
Dim qa_name() As String
Dim i As Integer
Dim j As Integer
Dim chart_area() As String
Dim control_name As String 'this is a placeholder for the current control
Dim control_name1 As String 'this is a placeholder for the secondary current
control
Dim control_first As String 'this is a placeholder for the very first box
control
Dim control_prev As String 'this is a placeholder for the previous control
Dim control_same As String 'this is a placeholder for the same control
Dim control_req As String 'this is a placeholder for the ...Req_Text
Dim control_act As String 'this is a placeholder for the ...Act_Text
Dim max_width As Single 'this is the max width the boxes can be
Dim max_req_width As Single 'this is the max req width the Req_Label can be
Dim max_area_width As Single 'this is the max area width the Area_Label can be
Dim gap_width As Single 'this is the width between area labels and boxes
Dim cal_height As Single 'this is the height of every box
Dim cal_space As Single 'this is the space between sets of boxes, divided
between areas
Dim buffer As Single
max_width = 0
max_req_width = 0
max_area_width = 0
i = 0
j = 0
'Get all available Areas
If Format(DateSerial([Forms]![frmReports]![Year_Combo1],
[Forms]![frmReports]![Month_Combo1], 1), "yymm") = Format(Date, "yymm") Then
sql = "SELECT DISTINCT L_tblArea_Tech.L_Area " & _
"FROM (tblData_Entry LEFT JOIN L_tblDate ON tblData_Entry.Date =
L_tblDate.L_Date_ID) LEFT JOIN L_tblArea_Tech ON tblData_Entry.Tech =
L_tblArea_Tech.L_Area_Tech_ID " & _
"WHERE (((L_tblArea_Tech.L_Area) <> 'Q/A') And ((Format([L_Date],
'yyyy')) >= " & [Forms]![frmReports]![Year_Combo1] & " And (Format([L_Date],
'yyyy')) <= " & [Forms]![frmReports]![Year_Combo2] & ") And
((Format([L_Date], 'mm')) >= " & [Forms]![frmReports]![Month_Combo1] & " And
(Format([L_Date], 'mm')) <= " & [Forms]![frmReports]![Month_Combo2] & ") And
((L_tblArea_Tech.L_Tech_Verified) = Yes)) Or (((L_tblArea_Tech.L_Area) <>
'Q/A') And ((L_tblArea_Tech.L_Tech_Verified) = Yes) And
((L_tblArea_Tech.L_Tech_Current) = Yes)) " & _
"ORDER BY L_tblArea_Tech.L_Area;"
Else
sql = "SELECT DISTINCT L_tblArea_Tech.L_Area " & _
"FROM (tblData_Entry LEFT JOIN L_tblDate ON tblData_Entry.Date =
L_tblDate.L_Date_ID) LEFT JOIN L_tblArea_Tech ON tblData_Entry.Tech =
L_tblArea_Tech.L_Area_Tech_ID " & _
"WHERE (((L_tblArea_Tech.L_Area) <> 'Q/A') And ((Format([L_Date],
'yyyy')) >= " & [Forms]![frmReports]![Year_Combo1] & " And (Format([L_Date],
'yyyy')) <= " & [Forms]![frmReports]![Year_Combo2] & ") And
((Format([L_Date], 'mm')) >= " & [Forms]![frmReports]![Month_Combo1] & " And
(Format([L_Date], 'mm')) <= " & [Forms]![frmReports]![Month_Combo2] & ") And
((L_tblArea_Tech.L_Tech_Verified) = Yes)) " & _
"ORDER BY L_tblArea_Tech.L_Area;"
End If
Set db = CurrentDb()
Set rst = db.OpenRecordset(sql)
rst.MoveLast 'if you don't do this, not getting total record count, only
count viewed records.
rst_count_areas = rst.RecordCount
If rst_count_areas = 0 Then
Else
ReDim chart_area(1 To rst_count_areas) As String
rst.MoveFirst
Do While Not rst.EOF
i = i + 1
chart_area(i) = rst!L_Area
'This is to auto-size the Area_Label to longest value.
control_name = i & "_Label"
Me(control_name).Caption = " " & chart_area(i) & " " 'For measuring
only. Caption reset later.
If fTextWidth(Me(control_name)) > max_area_width Then 'Area_Label
max_area_width = fTextWidth(Me(control_name))
Else
End If
rst.MoveNext
Loop
End If
rst.Close
'Get all available names
If Format(DateSerial([Forms]![frmReports]![Year_Combo1],
[Forms]![frmReports]![Month_Combo1], 1), "yymm") = Format(Date, "yymm") Then
sql = "SELECT DISTINCT L_tblArea_Tech.L_Tech " & _
"FROM (tblData_Entry LEFT JOIN L_tblDate ON tblData_Entry.Date =
L_tblDate.L_Date_ID) LEFT JOIN L_tblArea_Tech ON tblData_Entry.Name =
L_tblArea_Tech.L_Area_Tech_ID " & _
"WHERE (((Format([L_Date], 'yyyy')) >= " &
[Forms]![frmReports]![Year_Combo1] & " And (Format([L_Date], 'yyyy')) <= " &
[Forms]![frmReports]![Year_Combo2] & ") And ((Format([L_Date], 'mm')) >= " &
[Forms]![frmReports]![Month_Combo1] & " And (Format([L_Date], 'mm')) <= " &
[Forms]![frmReports]![Month_Combo2] & ") And ((L_tblArea_Tech.L_Area) =
'Q/A') And ((L_tblArea_Tech.L_Tech_Verified) = Yes)) Or
(((L_tblArea_Tech.L_Area) = 'Q/A') And ((L_tblArea_Tech.L_Tech_Verified) =
Yes) And ((L_tblArea_Tech.L_Tech_Current) = Yes)) " & _
"ORDER BY L_tblArea_Tech.L_Tech;"
Else
sql = "SELECT DISTINCT L_tblArea_Tech.L_Tech " & _
"FROM (tblData_Entry LEFT JOIN L_tblDate ON tblData_Entry.Date =
L_tblDate.L_Date_ID) LEFT JOIN L_tblArea_Tech ON tblData_Entry.Name =
L_tblArea_Tech.L_Area_Tech_ID " & _
"WHERE (((Format([L_Date], 'yyyy')) >= " &
[Forms]![frmReports]![Year_Combo1] & " And (Format([L_Date], 'yyyy')) <= " &
[Forms]![frmReports]![Year_Combo2] & ") And ((Format([L_Date], 'mm')) >= " &
[Forms]![frmReports]![Month_Combo1] & " And (Format([L_Date], 'mm')) <= " &
[Forms]![frmReports]![Month_Combo2] & ") And ((L_tblArea_Tech.L_Area) =
'Q/A') And ((L_tblArea_Tech.L_Tech_Verified) = Yes)) " & _
"ORDER BY L_tblArea_Tech.L_Tech;"
End If
Set rst = db.OpenRecordset(sql)
rst.MoveLast 'if you don't do this, not getting total record count, only
count viewed records.
rst_count_names = rst.RecordCount
If rst_count_names = 0 Then
Else
ReDim qa_name(1 To rst_count_names) As String
rst.MoveFirst
Do While Not rst.EOF
j = j + 1
qa_name(j) = rst!L_Tech
rst.MoveNext
Loop
End If
rst.Close
'Get information for required percentages.
sql = "SELECT [Excel_Q/A_By_Dept_Percentages].F1 AS L_Tech,
[Excel_Q/A_By_Dept_Percentages].F2 AS L_Area,
[Excel_Q/A_By_Dept_Percentages].F3 AS Perc " & _
"FROM [Excel_Q/A_By_Dept_Percentages] " & _
"ORDER BY [Excel_Q/A_By_Dept_Percentages].F1,
[Excel_Q/A_By_Dept_Percentages].F2;"
Set rst = db.OpenRecordset(sql)
rst.MoveLast
If rst.RecordCount = 0 Then
Else
rst.MoveFirst
Do While Not rst.EOF
i = 0
j = 0
If rst!Perc > max_width Then
max_width = rst!Perc
Else
End If
Do
i = i + 1
If chart_area(i) = rst!L_Area Then
Do
j = j + 1
If qa_name(j) = rst!L_Tech Then
control_act = i & "_" & j & "_Act_Text"
control_req = i & "_" & j & "_Req_Text"
Me(control_act) = 0 'do this b/c Act_Text needs
a default value in case no work is done by that person for that day.
Me(control_req) = rst!Perc
Else
End If
Loop Until qa_name(j) = rst!L_Tech Or j =
rst_count_names 'do this b/c there is a possibility a QA did not check
anything on one day.
Else
End If
Loop Until chart_area(i) = rst!L_Area Or i = rst_count_areas 'do
this b/c there is a possibility a dept was not checked at all on one day.
rst.MoveNext
Loop
End If
rst.Close
'Get information for actual percentages.
Set qdf = db.QueryDefs("test_qrychart_Q/A_By_Dept")
qdf.Parameters("[Forms]![frmReports]![Month_Combo1]") =
[Forms]![frmReports]![Month_Combo1]
qdf.Parameters("[Forms]![frmReports]![Day_Combo1]") =
[Forms]![frmReports]![Day_Combo1]
qdf.Parameters("[Forms]![frmReports]![Year_Combo1]") =
[Forms]![frmReports]![Year_Combo1]
qdf.Parameters("[Forms]![frmReports]![Month_Combo2]") =
[Forms]![frmReports]![Month_Combo2]
qdf.Parameters("[Forms]![frmReports]![Day_Combo2]") =
[Forms]![frmReports]![Day_Combo2]
qdf.Parameters("[Forms]![frmReports]![Year_Combo2]") =
[Forms]![frmReports]![Year_Combo2]
Set rst = qdf.OpenRecordset()
rst.MoveLast
If rst.RecordCount = 0 Then
Else
rst.MoveFirst
Do While Not rst.EOF
i = 0
j = 0
If rst!Perc > max_width Then
max_width = rst!Perc
Else
End If
Do
i = i + 1
If chart_area(i) = rst!L_Area Then
Do
j = j + 1
If qa_name(j) = rst!L_Tech Then
control_act = i & "_" & j & "_Act_Text"
control_req = i & "_" & j & "_Req_Text"
Me(control_act) = rst!Perc
'This will autosize Req_Label correctly if there
are no Act-over-Req percentages on the entire chart.
If Me(control_req) <> 0 And Me(control_act) >
Me(control_req) Then
max_req_width = 1
Else
End If
Else
End If
Loop Until qa_name(j) = rst!L_Tech Or j =
rst_count_names 'do this b/c there is a possibility a QA did not check
anything on one day.
Else
End If
Loop Until chart_area(i) = rst!L_Area Or i = rst_count_areas 'do
this b/c there is a possibility a dept was not checked at all on one day.
rst.MoveNext
Loop
'Req_Label sizing template. Measure max_width here in a label one time here
instead of repeatedly above.
If max_req_width = 0 Then
Me!Filler_Label.Caption = " " & Format(max_width * 100, "0.0") & "% "
'5 extra spaces total.
Else
Me!Filler_Label.Caption = " " & Format(max_width * 100, "0.0") & "% + "
& Format(max_width * 100, "0.0") & "% " '5 extra spaces total.
End If
max_req_width = fTextWidth(Me!Filler_Label)
End If
Me.InsideWidth = 6.5 * 1440 'Usable space
Me.InsideHeight = 8.25 * 1440 'Usable space
Me.Width = 6.5 * 1440 'Usable space
Me.Detail.Height = 8.25 * 1440 'Usable space
buffer = 0.01 * 1440
cal_space = 0.2 * 1440
cal_height = ((Me.InsideHeight) - (buffer * 2) - (cal_space *
(rst_count_areas - 1))) / (rst_count_names * rst_count_areas)
gap_width = 0.1 * 1440
form_width = (Me.InsideWidth) - max_req_width - max_area_width - gap_width
If rst_count_areas = 0 Then
Else
i = 0
Do
i = i + 1
j = 0
Do
j = j + 1
If i = 1 And j = 1 Then
control_first = "1_1_Act_Box"
control_same = i & "_" & j & "_Act_Box"
control_act = i & "_" & j & "_Act_Text"
control_req = i & "_" & j & "_Req_Text"
Me(control_first).Visible = 1
Me(control_first).Top = buffer
Me(control_first).Left = max_area_width + gap_width
Me(control_first).Height = cal_height
Me(control_first).Width = form_width * (Me(control_act) /
max_width)
control_name = i & "_" & j & "_Act_Label"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_first).Top
Me(control_name).Left = Me(control_first).Left
Me(control_name).Height = cal_height
control_name = i & "_" & j & "_Req_Box"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_first).Top
Me(control_name).Left = Me(control_first).Left
Me(control_name).Height = cal_height
Me(control_name).Width = form_width * (Me(control_req) /
max_width)
control_name = i & "_" & j & "_Req_Label"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_first).Top
Me(control_name).Height = cal_height
control_name = i & "_Label"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_first).Top
Me(control_name).Left = buffer
Me(control_name).Height = rst_count_names * cal_height
Me(control_name).Width = max_area_width
Me(control_name).Caption = chart_area(i)
VerticallyCenter Me(control_name)
Else
If j = 1 Then
control_name = i & "_" & j & "_Act_Box"
control_same = i & "_" & j & "_Act_Box"
control_act = i & "_" & j & "_Act_Text"
control_req = i & "_" & j & "_Req_Text"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_prev).Top + cal_space
+ cal_height
Me(control_name).Left = Me(control_first).Left
Me(control_name).Height = cal_height
Me(control_name).Width = form_width * (Me(control_act) /
max_width)
control_name = i & "_" & j & "_Act_Label"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_same).Top
Me(control_name).Left = Me(control_first).Left
Me(control_name).Height = cal_height
control_name = i & "_" & j & "_Req_Box"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_same).Top
Me(control_name).Left = Me(control_first).Left
Me(control_name).Height = cal_height
Me(control_name).Width = form_width * (Me(control_req) /
max_width)
control_name = i & "_" & j & "_Req_Label"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_same).Top
Me(control_name).Height = cal_height
control_name = i & "_Label"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_same).Top
Me(control_name).Left = buffer
Me(control_name).Height = rst_count_names * cal_height
Me(control_name).Width = max_area_width
Me(control_name).Caption = chart_area(i)
VerticallyCenter Me(control_name)
Else
control_name = i & "_" & j & "_Act_Box"
control_prev = i & "_" & j & "_Act_Box"
control_act = i & "_" & j & "_Act_Text"
control_req = i & "_" & j & "_Req_Text"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_same).Top + cal_height
Me(control_name).Left = Me(control_first).Left
Me(control_name).Height = cal_height
Me(control_name).Width = form_width * (Me(control_act) /
max_width)
control_name = i & "_" & j & "_Act_Label"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_same).Top + cal_height
Me(control_name).Left = Me(control_first).Left
Me(control_name).Height = cal_height
control_name = i & "_" & j & "_Req_Box"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_same).Top + cal_height
Me(control_name).Left = Me(control_first).Left
Me(control_name).Height = cal_height
Me(control_name).Width = form_width * (Me(control_req) /
max_width)
control_name = i & "_" & j & "_Req_Label"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_same).Top + cal_height
Me(control_name).Height = cal_height
control_same = i & "_" & j & "_Act_Box"
End If
End If
'The following is when the Req is 0.
If Me(control_req) = 0 Then
control_name = i & "_" & j & "_Req_Box"
Me(control_name).Visible = 0
control_name = i & "_" & j & "_Req_Label"
Me(control_name).Visible = 0
Else
End If
control_name = i & "_" & j & "_Req_Label"
If Me(control_act) <= Me(control_req) Then 'The actual is
less than the required.
control_name1 = i & "_" & j & "_Req_Box"
Me(control_name).Caption = " " & Format(Me(control_req)
* 100, "0.0") & "%"
Me(control_name).Width = max_req_width
Me(control_name).Left = Me(control_first).Left +
Me(control_name1).Width
VerticallyCenter Me(control_name)
If (Me(control_req) * 0.795) > Me(control_act) Then
'Bold Act_Label if Act is less than 80% of Req.
control_name = i & "_" & j & "_Act_Label"
Me(control_name).FontBold = True 'Act_Label
'Me(control_name).ForeColor = 255 'uncomment to
color RED
control_name = i & "_" & j & "_Req_Label"
Me(control_name).FontBold = True 'Req_Label
'Me(control_name).ForeColor = 255 'uncomment to
color RED
Else
End If
Else 'The actual is greater than the required AND req is NOT
0.
If Me(control_req) <> 0 Then
control_name1 = i & "_" & j & "_Act_Box"
Me(control_name).Caption = " " &
Format(Me(control_req) * 100, "0.0") & "% + " & Format((Me(control_act) -
Me(control_req)) * 100, "0.0") & "%"
Me(control_name).Width = max_req_width
Me(control_name).Left = Me(control_first).Left +
Me(control_name1).Width
VerticallyCenter Me(control_name)
'control_name = i & "_" & j & "_Req_Box" 'uncomment
to hide Req_Box.
'Me(control_name).Visible = 0 'uncomment to hide
Req_Box.
Else
End If
End If
'The following is after everything b/c the Act_Label may
become Bold.
'If so, the twip count will be a little larger. So instead
of adding a
'buffer to the following test, accurate results are had by
placing this
'after everything.
control_name = i & "_" & j & "_Act_Label"
control_name1 = i & "_" & j & "_Act_Box"
Me(control_name).Caption = " " & qa_name(j) & " " &
Format(Me(control_act) * 100, "0.0") & "% " '4 extra spaces total.
If fTextWidth(Me(control_name)) >= Me(control_name1).Width
Then
Me(control_name).TextAlign = 1
Me(control_name).Width = form_width
'This is so Req_Label and Act_Label don't overlap due to
short Req/Act_Box widths.
control_name1 = i & "_" & j & "_Req_Label"
If Me(control_req) <> 0 And (Me(control_name).Left +
fTextWidth(Me(control_name))) > Me(control_name1).Left Then
Me(control_name).Caption = " " & qa_name(j) & " " &
Format(Me(control_act) * 100, "0.0") & "% " & Format(Me(control_req) * 100,
"0.0") & "%" '4 extra spaces total.
Me(control_name1).Visible = 0
Else
'This is the normal caption, when Req/Act labels do
NOT overlap.
Me(control_name).Caption = " " & qa_name(j) & " " &
Format(Me(control_act) * 100, "0.0") & "%" '1 extra spaces total.
End If
Else
Me(control_name).Width = Me(control_name1).Width
Me(control_name).Caption = qa_name(j) & " " &
Format(Me(control_act) * 100, "0.0") & "% " '1 extra spaces total.
End If
VerticallyCenter Me(control_name)
Loop Until j = rst_count_names
Loop Until i = rst_count_areas
End If
qdf.Close
rst.Close
Set rst = Nothing
'Erase qa_name
'db.Close
'Set rst = Nothing 'do this for all objects
'sql = vbNullString 'do this for all strings
'unload myform -for all forms after it is to be closed.
End Sub
I created a form(A) which is used as a barchart. I have placed this form(A)
as a subform in a report, but it only displays a blank page. There is
nothing in this report except for this subform in the Detail section.
The form(A) is fed date information by another form(B) which currently only
handles the selection of a date range. I suspect, from posts and Help, that
I need to specify the "Link Child/Master Fields" of the subform within the
report. However, I do not know how to proceed because form(A) uses multiple
record sources. Are the blank "Link Child/Master Fields" most likely my
issue?
Below is the code for form(A). It's lengthy, sorry.
Private Sub Form_Load()
'Add error code
Dim db As dao.Database
Dim rst As dao.Recordset
Dim qdf As dao.QueryDef
Dim rst_count_areas As Integer
Dim rst_count_names As Integer
Dim sql As String
Dim qa_name() As String
Dim i As Integer
Dim j As Integer
Dim chart_area() As String
Dim control_name As String 'this is a placeholder for the current control
Dim control_name1 As String 'this is a placeholder for the secondary current
control
Dim control_first As String 'this is a placeholder for the very first box
control
Dim control_prev As String 'this is a placeholder for the previous control
Dim control_same As String 'this is a placeholder for the same control
Dim control_req As String 'this is a placeholder for the ...Req_Text
Dim control_act As String 'this is a placeholder for the ...Act_Text
Dim max_width As Single 'this is the max width the boxes can be
Dim max_req_width As Single 'this is the max req width the Req_Label can be
Dim max_area_width As Single 'this is the max area width the Area_Label can be
Dim gap_width As Single 'this is the width between area labels and boxes
Dim cal_height As Single 'this is the height of every box
Dim cal_space As Single 'this is the space between sets of boxes, divided
between areas
Dim buffer As Single
max_width = 0
max_req_width = 0
max_area_width = 0
i = 0
j = 0
'Get all available Areas
If Format(DateSerial([Forms]![frmReports]![Year_Combo1],
[Forms]![frmReports]![Month_Combo1], 1), "yymm") = Format(Date, "yymm") Then
sql = "SELECT DISTINCT L_tblArea_Tech.L_Area " & _
"FROM (tblData_Entry LEFT JOIN L_tblDate ON tblData_Entry.Date =
L_tblDate.L_Date_ID) LEFT JOIN L_tblArea_Tech ON tblData_Entry.Tech =
L_tblArea_Tech.L_Area_Tech_ID " & _
"WHERE (((L_tblArea_Tech.L_Area) <> 'Q/A') And ((Format([L_Date],
'yyyy')) >= " & [Forms]![frmReports]![Year_Combo1] & " And (Format([L_Date],
'yyyy')) <= " & [Forms]![frmReports]![Year_Combo2] & ") And
((Format([L_Date], 'mm')) >= " & [Forms]![frmReports]![Month_Combo1] & " And
(Format([L_Date], 'mm')) <= " & [Forms]![frmReports]![Month_Combo2] & ") And
((L_tblArea_Tech.L_Tech_Verified) = Yes)) Or (((L_tblArea_Tech.L_Area) <>
'Q/A') And ((L_tblArea_Tech.L_Tech_Verified) = Yes) And
((L_tblArea_Tech.L_Tech_Current) = Yes)) " & _
"ORDER BY L_tblArea_Tech.L_Area;"
Else
sql = "SELECT DISTINCT L_tblArea_Tech.L_Area " & _
"FROM (tblData_Entry LEFT JOIN L_tblDate ON tblData_Entry.Date =
L_tblDate.L_Date_ID) LEFT JOIN L_tblArea_Tech ON tblData_Entry.Tech =
L_tblArea_Tech.L_Area_Tech_ID " & _
"WHERE (((L_tblArea_Tech.L_Area) <> 'Q/A') And ((Format([L_Date],
'yyyy')) >= " & [Forms]![frmReports]![Year_Combo1] & " And (Format([L_Date],
'yyyy')) <= " & [Forms]![frmReports]![Year_Combo2] & ") And
((Format([L_Date], 'mm')) >= " & [Forms]![frmReports]![Month_Combo1] & " And
(Format([L_Date], 'mm')) <= " & [Forms]![frmReports]![Month_Combo2] & ") And
((L_tblArea_Tech.L_Tech_Verified) = Yes)) " & _
"ORDER BY L_tblArea_Tech.L_Area;"
End If
Set db = CurrentDb()
Set rst = db.OpenRecordset(sql)
rst.MoveLast 'if you don't do this, not getting total record count, only
count viewed records.
rst_count_areas = rst.RecordCount
If rst_count_areas = 0 Then
Else
ReDim chart_area(1 To rst_count_areas) As String
rst.MoveFirst
Do While Not rst.EOF
i = i + 1
chart_area(i) = rst!L_Area
'This is to auto-size the Area_Label to longest value.
control_name = i & "_Label"
Me(control_name).Caption = " " & chart_area(i) & " " 'For measuring
only. Caption reset later.
If fTextWidth(Me(control_name)) > max_area_width Then 'Area_Label
max_area_width = fTextWidth(Me(control_name))
Else
End If
rst.MoveNext
Loop
End If
rst.Close
'Get all available names
If Format(DateSerial([Forms]![frmReports]![Year_Combo1],
[Forms]![frmReports]![Month_Combo1], 1), "yymm") = Format(Date, "yymm") Then
sql = "SELECT DISTINCT L_tblArea_Tech.L_Tech " & _
"FROM (tblData_Entry LEFT JOIN L_tblDate ON tblData_Entry.Date =
L_tblDate.L_Date_ID) LEFT JOIN L_tblArea_Tech ON tblData_Entry.Name =
L_tblArea_Tech.L_Area_Tech_ID " & _
"WHERE (((Format([L_Date], 'yyyy')) >= " &
[Forms]![frmReports]![Year_Combo1] & " And (Format([L_Date], 'yyyy')) <= " &
[Forms]![frmReports]![Year_Combo2] & ") And ((Format([L_Date], 'mm')) >= " &
[Forms]![frmReports]![Month_Combo1] & " And (Format([L_Date], 'mm')) <= " &
[Forms]![frmReports]![Month_Combo2] & ") And ((L_tblArea_Tech.L_Area) =
'Q/A') And ((L_tblArea_Tech.L_Tech_Verified) = Yes)) Or
(((L_tblArea_Tech.L_Area) = 'Q/A') And ((L_tblArea_Tech.L_Tech_Verified) =
Yes) And ((L_tblArea_Tech.L_Tech_Current) = Yes)) " & _
"ORDER BY L_tblArea_Tech.L_Tech;"
Else
sql = "SELECT DISTINCT L_tblArea_Tech.L_Tech " & _
"FROM (tblData_Entry LEFT JOIN L_tblDate ON tblData_Entry.Date =
L_tblDate.L_Date_ID) LEFT JOIN L_tblArea_Tech ON tblData_Entry.Name =
L_tblArea_Tech.L_Area_Tech_ID " & _
"WHERE (((Format([L_Date], 'yyyy')) >= " &
[Forms]![frmReports]![Year_Combo1] & " And (Format([L_Date], 'yyyy')) <= " &
[Forms]![frmReports]![Year_Combo2] & ") And ((Format([L_Date], 'mm')) >= " &
[Forms]![frmReports]![Month_Combo1] & " And (Format([L_Date], 'mm')) <= " &
[Forms]![frmReports]![Month_Combo2] & ") And ((L_tblArea_Tech.L_Area) =
'Q/A') And ((L_tblArea_Tech.L_Tech_Verified) = Yes)) " & _
"ORDER BY L_tblArea_Tech.L_Tech;"
End If
Set rst = db.OpenRecordset(sql)
rst.MoveLast 'if you don't do this, not getting total record count, only
count viewed records.
rst_count_names = rst.RecordCount
If rst_count_names = 0 Then
Else
ReDim qa_name(1 To rst_count_names) As String
rst.MoveFirst
Do While Not rst.EOF
j = j + 1
qa_name(j) = rst!L_Tech
rst.MoveNext
Loop
End If
rst.Close
'Get information for required percentages.
sql = "SELECT [Excel_Q/A_By_Dept_Percentages].F1 AS L_Tech,
[Excel_Q/A_By_Dept_Percentages].F2 AS L_Area,
[Excel_Q/A_By_Dept_Percentages].F3 AS Perc " & _
"FROM [Excel_Q/A_By_Dept_Percentages] " & _
"ORDER BY [Excel_Q/A_By_Dept_Percentages].F1,
[Excel_Q/A_By_Dept_Percentages].F2;"
Set rst = db.OpenRecordset(sql)
rst.MoveLast
If rst.RecordCount = 0 Then
Else
rst.MoveFirst
Do While Not rst.EOF
i = 0
j = 0
If rst!Perc > max_width Then
max_width = rst!Perc
Else
End If
Do
i = i + 1
If chart_area(i) = rst!L_Area Then
Do
j = j + 1
If qa_name(j) = rst!L_Tech Then
control_act = i & "_" & j & "_Act_Text"
control_req = i & "_" & j & "_Req_Text"
Me(control_act) = 0 'do this b/c Act_Text needs
a default value in case no work is done by that person for that day.
Me(control_req) = rst!Perc
Else
End If
Loop Until qa_name(j) = rst!L_Tech Or j =
rst_count_names 'do this b/c there is a possibility a QA did not check
anything on one day.
Else
End If
Loop Until chart_area(i) = rst!L_Area Or i = rst_count_areas 'do
this b/c there is a possibility a dept was not checked at all on one day.
rst.MoveNext
Loop
End If
rst.Close
'Get information for actual percentages.
Set qdf = db.QueryDefs("test_qrychart_Q/A_By_Dept")
qdf.Parameters("[Forms]![frmReports]![Month_Combo1]") =
[Forms]![frmReports]![Month_Combo1]
qdf.Parameters("[Forms]![frmReports]![Day_Combo1]") =
[Forms]![frmReports]![Day_Combo1]
qdf.Parameters("[Forms]![frmReports]![Year_Combo1]") =
[Forms]![frmReports]![Year_Combo1]
qdf.Parameters("[Forms]![frmReports]![Month_Combo2]") =
[Forms]![frmReports]![Month_Combo2]
qdf.Parameters("[Forms]![frmReports]![Day_Combo2]") =
[Forms]![frmReports]![Day_Combo2]
qdf.Parameters("[Forms]![frmReports]![Year_Combo2]") =
[Forms]![frmReports]![Year_Combo2]
Set rst = qdf.OpenRecordset()
rst.MoveLast
If rst.RecordCount = 0 Then
Else
rst.MoveFirst
Do While Not rst.EOF
i = 0
j = 0
If rst!Perc > max_width Then
max_width = rst!Perc
Else
End If
Do
i = i + 1
If chart_area(i) = rst!L_Area Then
Do
j = j + 1
If qa_name(j) = rst!L_Tech Then
control_act = i & "_" & j & "_Act_Text"
control_req = i & "_" & j & "_Req_Text"
Me(control_act) = rst!Perc
'This will autosize Req_Label correctly if there
are no Act-over-Req percentages on the entire chart.
If Me(control_req) <> 0 And Me(control_act) >
Me(control_req) Then
max_req_width = 1
Else
End If
Else
End If
Loop Until qa_name(j) = rst!L_Tech Or j =
rst_count_names 'do this b/c there is a possibility a QA did not check
anything on one day.
Else
End If
Loop Until chart_area(i) = rst!L_Area Or i = rst_count_areas 'do
this b/c there is a possibility a dept was not checked at all on one day.
rst.MoveNext
Loop
'Req_Label sizing template. Measure max_width here in a label one time here
instead of repeatedly above.
If max_req_width = 0 Then
Me!Filler_Label.Caption = " " & Format(max_width * 100, "0.0") & "% "
'5 extra spaces total.
Else
Me!Filler_Label.Caption = " " & Format(max_width * 100, "0.0") & "% + "
& Format(max_width * 100, "0.0") & "% " '5 extra spaces total.
End If
max_req_width = fTextWidth(Me!Filler_Label)
End If
Me.InsideWidth = 6.5 * 1440 'Usable space
Me.InsideHeight = 8.25 * 1440 'Usable space
Me.Width = 6.5 * 1440 'Usable space
Me.Detail.Height = 8.25 * 1440 'Usable space
buffer = 0.01 * 1440
cal_space = 0.2 * 1440
cal_height = ((Me.InsideHeight) - (buffer * 2) - (cal_space *
(rst_count_areas - 1))) / (rst_count_names * rst_count_areas)
gap_width = 0.1 * 1440
form_width = (Me.InsideWidth) - max_req_width - max_area_width - gap_width
If rst_count_areas = 0 Then
Else
i = 0
Do
i = i + 1
j = 0
Do
j = j + 1
If i = 1 And j = 1 Then
control_first = "1_1_Act_Box"
control_same = i & "_" & j & "_Act_Box"
control_act = i & "_" & j & "_Act_Text"
control_req = i & "_" & j & "_Req_Text"
Me(control_first).Visible = 1
Me(control_first).Top = buffer
Me(control_first).Left = max_area_width + gap_width
Me(control_first).Height = cal_height
Me(control_first).Width = form_width * (Me(control_act) /
max_width)
control_name = i & "_" & j & "_Act_Label"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_first).Top
Me(control_name).Left = Me(control_first).Left
Me(control_name).Height = cal_height
control_name = i & "_" & j & "_Req_Box"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_first).Top
Me(control_name).Left = Me(control_first).Left
Me(control_name).Height = cal_height
Me(control_name).Width = form_width * (Me(control_req) /
max_width)
control_name = i & "_" & j & "_Req_Label"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_first).Top
Me(control_name).Height = cal_height
control_name = i & "_Label"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_first).Top
Me(control_name).Left = buffer
Me(control_name).Height = rst_count_names * cal_height
Me(control_name).Width = max_area_width
Me(control_name).Caption = chart_area(i)
VerticallyCenter Me(control_name)
Else
If j = 1 Then
control_name = i & "_" & j & "_Act_Box"
control_same = i & "_" & j & "_Act_Box"
control_act = i & "_" & j & "_Act_Text"
control_req = i & "_" & j & "_Req_Text"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_prev).Top + cal_space
+ cal_height
Me(control_name).Left = Me(control_first).Left
Me(control_name).Height = cal_height
Me(control_name).Width = form_width * (Me(control_act) /
max_width)
control_name = i & "_" & j & "_Act_Label"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_same).Top
Me(control_name).Left = Me(control_first).Left
Me(control_name).Height = cal_height
control_name = i & "_" & j & "_Req_Box"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_same).Top
Me(control_name).Left = Me(control_first).Left
Me(control_name).Height = cal_height
Me(control_name).Width = form_width * (Me(control_req) /
max_width)
control_name = i & "_" & j & "_Req_Label"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_same).Top
Me(control_name).Height = cal_height
control_name = i & "_Label"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_same).Top
Me(control_name).Left = buffer
Me(control_name).Height = rst_count_names * cal_height
Me(control_name).Width = max_area_width
Me(control_name).Caption = chart_area(i)
VerticallyCenter Me(control_name)
Else
control_name = i & "_" & j & "_Act_Box"
control_prev = i & "_" & j & "_Act_Box"
control_act = i & "_" & j & "_Act_Text"
control_req = i & "_" & j & "_Req_Text"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_same).Top + cal_height
Me(control_name).Left = Me(control_first).Left
Me(control_name).Height = cal_height
Me(control_name).Width = form_width * (Me(control_act) /
max_width)
control_name = i & "_" & j & "_Act_Label"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_same).Top + cal_height
Me(control_name).Left = Me(control_first).Left
Me(control_name).Height = cal_height
control_name = i & "_" & j & "_Req_Box"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_same).Top + cal_height
Me(control_name).Left = Me(control_first).Left
Me(control_name).Height = cal_height
Me(control_name).Width = form_width * (Me(control_req) /
max_width)
control_name = i & "_" & j & "_Req_Label"
Me(control_name).Visible = 1
Me(control_name).Top = Me(control_same).Top + cal_height
Me(control_name).Height = cal_height
control_same = i & "_" & j & "_Act_Box"
End If
End If
'The following is when the Req is 0.
If Me(control_req) = 0 Then
control_name = i & "_" & j & "_Req_Box"
Me(control_name).Visible = 0
control_name = i & "_" & j & "_Req_Label"
Me(control_name).Visible = 0
Else
End If
control_name = i & "_" & j & "_Req_Label"
If Me(control_act) <= Me(control_req) Then 'The actual is
less than the required.
control_name1 = i & "_" & j & "_Req_Box"
Me(control_name).Caption = " " & Format(Me(control_req)
* 100, "0.0") & "%"
Me(control_name).Width = max_req_width
Me(control_name).Left = Me(control_first).Left +
Me(control_name1).Width
VerticallyCenter Me(control_name)
If (Me(control_req) * 0.795) > Me(control_act) Then
'Bold Act_Label if Act is less than 80% of Req.
control_name = i & "_" & j & "_Act_Label"
Me(control_name).FontBold = True 'Act_Label
'Me(control_name).ForeColor = 255 'uncomment to
color RED
control_name = i & "_" & j & "_Req_Label"
Me(control_name).FontBold = True 'Req_Label
'Me(control_name).ForeColor = 255 'uncomment to
color RED
Else
End If
Else 'The actual is greater than the required AND req is NOT
0.
If Me(control_req) <> 0 Then
control_name1 = i & "_" & j & "_Act_Box"
Me(control_name).Caption = " " &
Format(Me(control_req) * 100, "0.0") & "% + " & Format((Me(control_act) -
Me(control_req)) * 100, "0.0") & "%"
Me(control_name).Width = max_req_width
Me(control_name).Left = Me(control_first).Left +
Me(control_name1).Width
VerticallyCenter Me(control_name)
'control_name = i & "_" & j & "_Req_Box" 'uncomment
to hide Req_Box.
'Me(control_name).Visible = 0 'uncomment to hide
Req_Box.
Else
End If
End If
'The following is after everything b/c the Act_Label may
become Bold.
'If so, the twip count will be a little larger. So instead
of adding a
'buffer to the following test, accurate results are had by
placing this
'after everything.
control_name = i & "_" & j & "_Act_Label"
control_name1 = i & "_" & j & "_Act_Box"
Me(control_name).Caption = " " & qa_name(j) & " " &
Format(Me(control_act) * 100, "0.0") & "% " '4 extra spaces total.
If fTextWidth(Me(control_name)) >= Me(control_name1).Width
Then
Me(control_name).TextAlign = 1
Me(control_name).Width = form_width
'This is so Req_Label and Act_Label don't overlap due to
short Req/Act_Box widths.
control_name1 = i & "_" & j & "_Req_Label"
If Me(control_req) <> 0 And (Me(control_name).Left +
fTextWidth(Me(control_name))) > Me(control_name1).Left Then
Me(control_name).Caption = " " & qa_name(j) & " " &
Format(Me(control_act) * 100, "0.0") & "% " & Format(Me(control_req) * 100,
"0.0") & "%" '4 extra spaces total.
Me(control_name1).Visible = 0
Else
'This is the normal caption, when Req/Act labels do
NOT overlap.
Me(control_name).Caption = " " & qa_name(j) & " " &
Format(Me(control_act) * 100, "0.0") & "%" '1 extra spaces total.
End If
Else
Me(control_name).Width = Me(control_name1).Width
Me(control_name).Caption = qa_name(j) & " " &
Format(Me(control_act) * 100, "0.0") & "% " '1 extra spaces total.
End If
VerticallyCenter Me(control_name)
Loop Until j = rst_count_names
Loop Until i = rst_count_areas
End If
qdf.Close
rst.Close
Set rst = Nothing
'Erase qa_name
'db.Close
'Set rst = Nothing 'do this for all objects
'sql = vbNullString 'do this for all strings
'unload myform -for all forms after it is to be closed.
End Sub