THEO TODMAN’S WEBSITE CODE PAGES


This Page provides a jumping-off point for the VBA Code that generates my Website.

Table of Code Documentation Location 31 (11 items)

Form_OpenCount_BookPapersFunctor_19Functor_21
Functor_22Functor_23Number_FormatAeon_Authors_Add
BooksToNotes_PrelimsCheckerJacks_Non_Prime.

To access information, click on one of the links in the table above.

Go to top of page



Source Code of: Aeon_Authors_Add
Procedure Type: Public Sub
Module: New Code
Lines of Code: 108
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Aeon_Authors_Add()
0002Dim rs As Recordset
0003Dim rsAuthors As Recordset
0004Dim rsAuthor_Parameter As Recordset
0005Dim strQuery As String
0006Dim strAuthor As String
0007Dim strAuthor_Saved As String
0008Dim Author As String
0009Dim Author_Reformat As String
0010Dim i As Integer
0011Dim j As Integer
0012Dim k As Integer
0013Dim x As Integer
0014Dim strMessage As String
0015Dim Output_Authors As Boolean
0016Dim Output_Old_Authors As Boolean
0017 strMessage = "Get ready to output Authors pages? Usually wait to output until we've output the Aeon note with 'Refresh Links', but this will maintain the Author_Parameter table."
0018If MsgBox(strMessage, vbYesNo + vbDefaultButton1) = vbYes Then
0019 Output_Authors = True
0020 strMessage = "Add all relevant Authors pages, including newly-loaded ones, to Author_Parameter table?"
0021 If MsgBox(strMessage, vbYesNo + vbDefaultButton1) = vbYes Then
0022 Output_Old_Authors = True
0023 Else
0024 Output_Old_Authors = False
0025 End If
0026Else
0027 Output_Authors = False
0028 Output_Old_Authors = False
0029End If
0030strAuthor_Saved = ""
0031' Clear & ready Author_Parameter Table
0032 strQuery = "DELETE * FROM Author_Parameter;"
0033DoCmd.RunSQL (strQuery)
0034 strQuery = "SELECT * FROM Author_Parameter;"
0035Set rsAuthor_Parameter = CurrentDb.OpenRecordset(strQuery)
0036' Select Aeon_Files rows with Authors encoded
0037 strQuery = "SELECT Aeon_Files.Author_Names FROM Aeon_Files WHERE (((Aeon_Files.Author_Names) Like ""*+A*"")) ORDER BY Aeon_Files.Author_Names;"
0038Set rs = CurrentDb.OpenRecordset(strQuery)
0039rs.MoveFirst
0040Do Until rs.EOF
0041 strAuthor = rs.Fields(0)
0042 If strAuthor <> strAuthor_Saved Then
0043 'Find the authors
0044 i = 1
0045 j = 1
0046 Do Until j = 0
0047 j = InStr(i, strAuthor, "A+")
0048 If j > 0 Then
0049 Author = Mid(strAuthor, i + 2, j - i - 2)
0050 'Check if on Author's Table
0051 strQuery = "SELECT Authors.Author_Name, Authors.Author_Name_Display FROM Authors WHERE (((Authors.Author_Name)=""" & Author & """));"
0052 Set rsAuthors = CurrentDb.OpenRecordset(strQuery)
0053 If rsAuthors.EOF Then
0054 Debug.Print Author
0055 Author_Reformat = Author
0056 x = InStr(Author_Reformat, "(")
0057 If x > 0 Then
0058 k = InStr(x, Author_Reformat, ")")
0059 If k > 0 Then
0060 Author_Reformat = Mid(Author_Reformat, x + 1, k - x - 1) & " " & Trim(Left(Author_Reformat, x - 1))
0061 End If
0062 End If
0063 'Load to Author's table
0064 rsAuthors.AddNew
0065 rsAuthors.Fields(0) = Author
0066 rsAuthors.Fields(1) = Author_Reformat
0067 rsAuthors.Update
0068 Set rsAuthors = Nothing
0069 'Add to Author_Parameter Table, ready for output of the Author pages
0070 rsAuthor_Parameter.AddNew
0071 rsAuthor_Parameter.Fields(0) = Author
0072 rsAuthor_Parameter.Update
0073 Else
0074 If Output_Old_Authors = True Then
0075 'Add to Author_Parameter Table, ready for output of the Author pages (existing authors need to have their pages updated)
0076 rsAuthor_Parameter.AddNew
0077 rsAuthor_Parameter.Fields(0) = Author
0078 On Error Resume Next
0079 rsAuthor_Parameter.Update
0080 End If
0081 End If
0082 i = j
0083 i = InStr(i, strAuthor, "+A")
0084 If i = 0 Then
0085 j = 0
0086 End If
0087 End If
0088 Loop
0089 End If
0090 strAuthor_Saved = strAuthor
0091 rs.MoveNext
0092Loop
0093If Output_Authors = True Then
0094 strMessage = "Actually output the Authors pages? Usually wait until we've output the Aeon note with 'Refresh Links'."
0095 If MsgBox(strMessage, vbYesNo + vbDefaultButton2) = vbYes Then
0096 'Output the Author pages
0097 strDataQuery = "Authors_List_Selected_Authors"
0098 strControlTable = "Authors"
0099 strOutputFileShort = "Author"
0100 strOutputFolder = TheoWebsiteRoot & "\Authors\"
0101 strOutputFile = ""
0102 CreateAuthorsWebPages ("Regen")
0103 End If
0104End If
0105OK = MsgBox("Authors added OK at " & Now(), vbOKOnly)
0106Set rs = Nothing
0107Set rsAuthor_Parameter = Nothing
0108End Sub

Procedures Calling This Procedure (Aeon_Authors_Add) Procedures Called By This Procedure (Aeon_Authors_Add) Tables / Queries / Fragments Directly Used By This Procedure (Aeon_Authors_Add) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: BooksToNotes_Prelims
Procedure Type: Public Sub
Module: Testing
Lines of Code: 10

Line-No. / Ref.Code Line
0001Public Sub BooksToNotes_Prelims()
0002Dim strQuery As String
0003 strQuery = "DELETE * FROM Cross_Reference_Prelims;"
0004DoCmd.RunSQL (strQuery)
0005 strQuery = "BooksToNotes_Prelims_GEN"
0006DoCmd.OpenQuery (strQuery)
0007'Delete rows associated with Note 874 (Auto-Xref Test Note)
0008 strQuery = "DELETE * FROM Cross_Reference_Prelims WHERE Calling_ID = 874 AND Calling_Type = ""N"";"
0009DoCmd.RunSQL (strQuery)
0010End Sub

Procedures Calling This Procedure (BooksToNotes_Prelims) Tables / Queries / Fragments Directly Used By This Procedure (BooksToNotes_Prelims) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: Checker
Procedure Type: Public Sub
Module: Testing
Lines of Code: 16

Line-No. / Ref.Code Line
0001Public Sub Checker()
0002Dim rs As Recordset
0003Dim i As Integer
0004Dim ifields As Integer
0005'Set rs = CurrentDb.OpenRecordset("TRANSFORM Sum([Year_Crosstab].[Hours ]) AS Hours SELECT Average_Plans.Project, Average_Plans.[Average This Qtr Plan] AS [Planned Weekly Hours], 0 AS [Planned QTD %age], Sum(0) AS [QTD Actual %], Round([Average YTD Plan],2) AS [Planned YTD %age], Sum(0) AS [YTD Actual %], Sum(0) AS [QTD Actual Hours], Sum(Year_Crosstab.Hours) AS [YTD Actual Hours] FROM Average_Plans LEFT JOIN Year_Crosstab ON Average_Plans.Project = Year_Crosstab.Group WHERE ((((Year_Crosstab.Period) >= ""2019-10"" And (Year_Crosstab.Period) <= ""2020-09"") Or (Year_Crosstab.Period) Is Null)) GROUP BY Average_Plans.Project, Average_Plans.[Average This Qtr Plan], Round([Average YTD Plan],2) ORDER BY Average_Plans.Project PIVOT Year_Crosstab.Period;")
0006 Set rs = CurrentDb.OpenRecordset("SELECT * FROM Project_Plans;")
0007rs.MoveFirst
0008ifields = rs.Fields.Count
0009Do Until rs.EOF
0010 For i = 0 To ifields - 1
0011 Debug.Print rs.Fields(i)
0012 Stop
0013 Next i
0014 rs.MoveNext
0015Loop
0016End Sub

Tables / Queries / Fragments Directly Used By This Procedure (Checker) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: Count_BookPapers
Procedure Type: Public Function
Module: New Code
Lines of Code: 13

Line-No. / Ref.Code Line
0001Public Function Count_BookPapers(strDataQuery_Saved, Author, Medium)
0002Dim rs As Recordset
0003Dim strQuery As String
0004strQuery = "SELECT Count(" & strDataQuery_Saved & ".Title) AS CountOfTitle FROM " & strDataQuery_Saved & " GROUP BY " & strDataQuery_Saved & ".Author_Name, " & strDataQuery_Saved & ".Medium HAVING (((" & strDataQuery_Saved & ".Author_Name)=""" & Author & """) AND ((" & strDataQuery_Saved & ".Medium)=""" & Medium & """));"
0005Set rs = CurrentDb.OpenRecordset(strQuery)
0006If rs.EOF Then
0007 Count_BookPapers = 0
0008Else
0009 rs.MoveLast
0010 Count_BookPapers = rs.Fields(0)
0011End If
0012Set rs = Nothing
0013End Function

Go To Top of This Page
Link to VBA Code Control Page


Source Code of: Form_Open
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 22
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub Form_Open(Cancel As Integer)
0002Dim rsTableToRead As Recordset
0003Dim Date_Check As Date
0004 OK = Check_Database_Size()
0005Debug.Print Now() & " - Main Database size = " & Check_Database_Size & "Mb"
0006 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT Archive_Reading_Lists, Archive_Printable_Versions, Document_Tables_Full, Document_Queries_Full FROM System_Parameters;")
0007rsTableToRead.MoveFirst
0008Archive_Reading_Lists = rsTableToRead.Fields(0).Value
0009Archive_Printable_Versions = rsTableToRead.Fields(1).Value
0010Document_Tables_Full = rsTableToRead.Fields(2).Value
0011Document_Queries_Full = rsTableToRead.Fields(3).Value
0012Full_Regen = False
0013Set rsTableToRead = Nothing
0014If 1 = 2 Then 'Don't perform this for the time being!
0015 Set rsTableToRead = CurrentDb.OpenRecordset("NGS_Latest_Import")
0016 rsTableToRead.MoveFirst
0017 Date_Check = rsTableToRead.Fields(0)
0018 If Date_Check <> Date Then
0019 MsgBox ("Import NGS Ratings for Essex & Suffolk for " & Date & "!")
0020 End If
0021End If
0022End Sub

Procedures Called By This Procedure (Form_Open) Tables / Queries / Fragments Directly Used By This Procedure (Form_Open) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: Functor_19
Procedure Type: Public Function
Module: Functors
Lines of Code: 42
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Functor_19(Note_ID, Note_Title, Note_Text)
0002'Add jump table and record counts for Aeon Note 1292
0003Dim rs As Recordset
0004Dim strQuery As String
0005Dim Papers_Read As String
0006Dim Papers_UnReadTotal As String
0007Dim Papers_UnRead(10) As Integer
0008Dim Note_Text_Local As String
0009Dim i As Integer
0010Note_Text_Local = Note_Text
0011 strQuery = "SELECT Aeon_Files.[Read?], Count(Aeon_Files.WebRef_ID) AS CountOfWebRef_ID FROM Aeon_Files WHERE (((Aeon_Files.Aeon_Note_ID) = 1292) And ((Aeon_Files.[Exclude?]) = False)) GROUP BY Aeon_Files.[Read?];"
0012Set rs = CurrentDb.OpenRecordset(strQuery)
0013If Not rs.EOF Then
0014 rs.MoveFirst
0015 Papers_Read = rs.Fields(1)
0016 OK = Number_Format(Papers_Read)
0017 rs.MoveLast
0018 Papers_UnReadTotal = rs.Fields(1)
0019 OK = Number_Format(Papers_UnReadTotal)
0020End If
0021 strQuery = "SELECT Aeon_Files.Priority, Count(Aeon_Files.WebRef_ID) AS CountOfWebRef_ID FROM Aeon_Files WHERE (((Aeon_Files.Aeon_Note_ID) = 1292) And ((Aeon_Files.[Read?]) = False) AND ((Aeon_Files.[Exclude?])=False)) GROUP BY Aeon_Files.Priority ORDER BY Aeon_Files.Priority;"
0022Set rs = CurrentDb.OpenRecordset(strQuery)
0023If Not rs.EOF Then
0024 rs.MoveFirst
0025 Do Until rs.EOF
0026 Papers_UnRead(rs.Fields(0)) = rs.Fields(1)
0027 rs.MoveNext
0028 Loop
0029End If
0030Note_Text_Local = "<br><CENTER><TABLE class = ""ReadingList"" WIDTH=1200><TR>"
0031Note_Text_Local = Note_Text_Local & "<TD class = ""BridgeLeft""> <a href=""#Off-Page_Link_Project_Note_1292_Intro""><B>Introduction</a></B></TD>"
0032Note_Text_Local = Note_Text_Local & "<TD class = ""BridgeLeft""> <a href=""#Off-Page_Link_Project_Note_1292_Read""><B>Papers Read</a>: </B>" & Papers_Read & "</TD>"
0033Note_Text_Local = Note_Text_Local & "<TD class = ""BridgeLeft""> <B>Papers Unread: " & Papers_UnReadTotal & "</B> &rarr; </TD>"
0034For i = 0 To 10
0035 If Papers_UnRead(i) > 0 Then
0036 Note_Text_Local = Note_Text_Local & "<TD class = ""BridgeLeft""> <a href=""#Off-Page_Link_Project_Note_1292_Pri_" & i & """><B>Pri " & i & "</B></a>: " & Papers_UnRead(i) & "</TD>"
0037 End If
0038Next i
0039Note_Text_Local = Note_Text_Local & "</TR></TABLE></CENTER><a name=""Off-Page_Link_Project_Note_1292_Intro""></a>"
0040Note_Text = Note_Text_Local
0041Functor_19 = "Yes"
0042End Function

Procedures Calling This Procedure (Functor_19) Procedures Called By This Procedure (Functor_19) Tables / Queries / Fragments Directly Used By This Procedure (Functor_19) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: Functor_21
Procedure Type: Public Function
Module: Functors
Lines of Code: 784
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Functor_21(strParameter, strTable, Optional strParameter2)
0002'This function formats a web-table from a Cross-tab query (or equivalent tabular array)
0003Dim rs As Recordset
0004Dim rs_Temp As Recordset
0005Dim i As Integer
0006Dim j As Long
0007Dim m As Integer
0008Dim n As Integer
0009Dim iCount As Integer
0010Dim k(100)
0011Dim iCols As Integer
0012Dim strTable_Local As String
0013Dim strElement As String
0014Dim strCell As String
0015Dim strCell_1_Saved As String
0016Dim strCell_4_Saved As String
0017Dim strQuery As String
0018Dim strQuery2 As String
0019Dim strHeader As String
0020Dim iTotal_Col As Integer
0021Dim strParameter2_Local As String
0022Dim Col_Width As Single
0023Dim strWork As String
0024Dim strWork2 As String
0025Dim Lingo As String
0026Dim Wiki_Lang As Integer
0027Dim Wiki_Script As Integer
0028Dim Language As String
0029Dim strTable_Saved As String
0030Dim strLesson As String
0031If IsMissing(strParameter2) Then
0032 strParameter2_Local = ""
0033Else
0034 strParameter2_Local = strParameter2
0035End If
0036iCount = 1
0037Select Case strParameter
0038 Case 1
0039 strQuery = "Cross_Reference_By_Type"
0040 iTotal_Col = 0
0041 Case 2
0042 strQuery = "Cross_Reference_Changes_By_Type"
0043 iTotal_Col = 0
0044 Case 3
0045 strQuery = "Oboe_Practice_Hours_List"
0046 iTotal_Col = 0
0047 Case 4
0048 strQuery = "Auto_Ref_Notes_Stats_Summary"
0049 iTotal_Col = 4
0050 Case 5
0051 iTotal_Col = 5
0052 strQuery = "Auto_Ref_Notes_Stats_Detailed"
0053 Case 6
0054 iTotal_Col = 6 'Dummy
0055 strQuery = "Functor_Calls"
0056 Case 7
0057 Find_Functors
0058 iTotal_Col = 6 'Dummy
0059 strQuery = "Functors_FbyN"
0060 Case 8
0061 Find_Functors
0062 iTotal_Col = 6 'Dummy
0063 strQuery = "Functors_NbyF"
0064 Case 9
0065 strQuery = "Auto_Ref_Notes_Stats_Grand_Summary"
0066 iTotal_Col = 5
0067 Case 10
0068 strQuery = "Auto_Ref_Notes_Stats_Grandest_Summary"
0069 iTotal_Col = 4
0070 Case 11
0071 'Ready some stats!
0072 strQuery = "DELETE * FROM Temp_Lang_Date_Last_Study;"
0073 DoCmd.RunSQL (strQuery)
0074 strQuery = "Temp_Lang_Date_Last_Study_GEN"
0075 DoCmd.OpenQuery (strQuery)
0076 strQuery = "Language_Location_Primer_Time_Zap"
0077 DoCmd.OpenQuery (strQuery)
0078 strQuery = "Language_Location_Primer_Date_Time_Updt"
0079 DoCmd.OpenQuery (strQuery)
0080 strQuery = "Language_Animadversions_List"
0081 iTotal_Col = 6
0082 Case 12
0083 strQuery = "Language_Animadversions_XTab"
0084 iTotal_Col = 50
0085 Case 13
0086 strQuery = "Language_Animadversions_XTab_Pri2"
0087 iTotal_Col = 50
0088 Case 14
0089 strQuery = "PID_Notes_Used_By_Thesis_Chapter_Xtab"
0090 iTotal_Col = 12
0091 Case 15
0092 strQuery = "IdentityPapersRead_Unreferenced"
0093 DoCmd.OpenQuery ("IdentityPapersRead_Unreferenced_Gen")
0094 iTotal_Col = 50
0095 Case 16
0096 strQuery = "PID_Notes_Used_By_Thesis_Chapter_List_Xtab"
0097 iTotal_Col = 12
0098 Case 17
0099 strQuery = "Works_Missing_By_Thesis_Chapter"
0100 iTotal_Col = 20
0101 Case 18
0102 strQuery = "IdentityBooks_Unreferenced"
0103 DoCmd.OpenQuery ("IdentityBooks_Unreferenced_Gen")
0104 iTotal_Col = 50
0105 Case 19
0106 strQuery = "PID_Notes_RL_Category_Xtab"
0107 Case 20
0108 Select Case strParameter2_Local
0109 Case 1
0110 strQuery = "Ling_Database_Summary_XTab_Vocabulary_Latin"
0111 Case 2
0112 strQuery = "Ling_Database_Summary_XTab_Vocabulary_NonLatin"
0113 Case 3
0114 strQuery = "Ling_Database_Summary_XTab_Dialogue_Latin"
0115 Case 4
0116 strQuery = "Ling_Database_Summary_XTab_Dialogue_NonLatin"
0117 Case 5
0118 strQuery = "Ling_Combined_XTab"
0119 End Select
0120 iTotal_Col = 50
0121 Case 21
0122 Select Case strParameter2_Local
0123 Case 1
0124 strQuery = "Ling_Language_Vocab_List_All"
0125 Case 2
0126 strQuery = "Ling_Language_Vocab_Phrase_List_All"
0127 Case 3
0128 strQuery = "Ling_Language_Dialogue_List_All"
0129 Case 4
0130 strQuery = "Ling_Language_Vocab_List_All_LessonSeq"
0131 Case 5
0132 strQuery = "Ling_Language_Vocab_Phrase_List_All_LessonSeq"
0133 Case Else 'Must contain a Note_ID
0134 i = Val(strParameter2_Local)
0135 strQuery = "UPDATE Ling_Crosstab_Group_Control SET Ling_Crosstab_Group_Control.Selected = False;" 'Set requests off
0136 DoCmd.RunSQL (strQuery)
0137 strQuery = "SELECT Ling_Crosstab_Group_Control.Grouping, Ling_Crosstab_Group_Control.Selected, Ling_Crosstab_Group_Control.[Vocabulary by Lesson], Ling_Crosstab_Group_Control.[Vocabulary by Category], Ling_Crosstab_Group_Control.[Phrase by Lesson], Ling_Crosstab_Group_Control.[Phrase by Category], Ling_Crosstab_Group_Control.[Dialogue by Lesson] FROM Ling_Crosstab_Group_Control WHERE (((Ling_Crosstab_Group_Control.[Vocabulary by Lesson])=" & i & ")) OR (((Ling_Crosstab_Group_Control.[Vocabulary by Category])=" & i & ")) OR (((Ling_Crosstab_Group_Control.[Phrase by Lesson])=" & i & ")) OR (((Ling_Crosstab_Group_Control.[Phrase by Category])=" & i & ")) OR (((Ling_Crosstab_Group_Control.[Dialogue by Lesson])=" & i & "));"
0138 Set rs_Temp = CurrentDb.OpenRecordset(strQuery)
0139 If Not rs_Temp.EOF Then
0140 rs_Temp.MoveFirst
0141 rs_Temp.Edit
0142 rs_Temp.Fields(1) = True
0143 rs_Temp.Update
0144 End If
0145 If rs_Temp.Fields(2) = i Then
0146 strParameter2_Local = 7
0147 strQuery = "Ling_Language_Vocab_List_All_Grouped_LessonSeq"
0148 End If
0149 If rs_Temp.Fields(3) = i Then
0150 strParameter2_Local = 6
0151 strQuery = "Ling_Language_Vocab_List_All_Grouped"
0152 End If
0153 If rs_Temp.Fields(4) = i Then
0154 strParameter2_Local = 8
0155 strQuery = "Ling_Language_Vocab_Phrase_List_LessonSeq"
0156 End If
0157 If rs_Temp.Fields(5) = i Then
0158 strParameter2_Local = 9
0159 strQuery = "Ling_Language_Vocab_Phrase_List"
0160 End If
0161 If rs_Temp.Fields(6) = i Then
0162 strParameter2_Local = 10
0163 strQuery = "Ling_Language_Dialogue_List"
0164 End If
0165 Set rs_Temp = Nothing
0166 End Select
0167 iTotal_Col = 50
0168 Case 22
0169 Select Case strParameter2_Local
0170 Case 1
0171 strQuery = "Ling_Language_Vocab_List_Latin_Reduced"
0172 Case 2
0173 strQuery = "Ling_Language_Vocab_List_NonLatin_Reduced"
0174 Case 3
0175 strQuery = "Ling_Language_Dialogue_List_Latin_Reduced"
0176 Case 4
0177 strQuery = "Ling_Language_Dialogue_List_NonLatin_Reduced"
0178 Case Else
0179 'Case contains a Note ID; first determine language and whether for Vocab or Dialogue ...
0180 '... try Vocab ...
0181 strQuery = "SELECT Language_Location_Primer.Language_Key, Language_Location_Primer.Ling_Vocab_Note, Language_Location_Primer.[Non_Latin_Script?] FROM Language_Location_Primer WHERE (((Language_Location_Primer.Ling_Vocab_Note)=Val(" & strParameter2_Local & ")));"
0182 Set rs_Temp = CurrentDb.OpenRecordset(strQuery)
0183 If rs_Temp.EOF Then
0184 '... try Dialogue ...
0185 strQuery = "SELECT Language_Location_Primer.Language_Key, Language_Location_Primer.Ling_Dialogue_Note, Language_Location_Primer.[Non_Latin_Script?] FROM Language_Location_Primer WHERE (((Language_Location_Primer.Ling_Dialogue_Note)=Val(" & strParameter2_Local & ")));"
0186 Set rs_Temp = CurrentDb.OpenRecordset(strQuery)
0187 rs_Temp.MoveFirst 'I ought to check for EOF, but it won't occur!
0188 Lingo = rs_Temp.Fields(0)
0189 If rs_Temp.Fields(2) = True Then
0190 'strQuery = "SELECT Ling_Language_Dialogue_List_NonLatin.Lesson, Ling_Language_Dialogue_List_NonLatin.Dialogue, Ling_Language_Dialogue_List_NonLatin.ID, Ling_Language_Dialogue_List_NonLatin.Speaker, Ling_Language_Dialogue_List_NonLatin.English, Ling_Language_Dialogue_List_NonLatin.[Phrase Transliteration], Ling_Language_Dialogue_List_NonLatin.Phrase FROM Ling_Language_Dialogue_List_NonLatin WHERE (((Ling_Language_Dialogue_List_NonLatin.Language) = """ & Lingo & """)) ORDER BY Ling_Language_Dialogue_List_NonLatin.Lesson, Ling_Language_Dialogue_List_NonLatin.Dialogue, Ling_Language_Dialogue_List_NonLatin.ID;"
0191 strQuery = "SELECT Ling_Language_Dialogue_List_NonLatin.Lesson, Dialogue & ""-"" & [ID] & ""-"" & [Speaker] AS Ref, [Phrase Transliteration] & ""<hr>"" & [English] AS [Transliteration / English], Ling_Language_Dialogue_List_NonLatin.Phrase FROM Ling_Language_Dialogue_List_NonLatin WHERE (((Ling_Language_Dialogue_List_NonLatin.Language) = """ & Lingo & """)) ORDER BY Ling_Language_Dialogue_List_NonLatin.Lesson, [Dialogue] , [ID] , [Speaker];"
0192 Else
0193 strQuery = "SELECT Ling_Language_Dialogue_List_Latin.Lesson, Ling_Language_Dialogue_List_Latin.Dialogue, Ling_Language_Dialogue_List_Latin.ID, Ling_Language_Dialogue_List_Latin.Speaker, Ling_Language_Dialogue_List_Latin.English, Ling_Language_Dialogue_List_Latin.Phrase FROM Ling_Language_Dialogue_List_Latin WHERE (((Ling_Language_Dialogue_List_Latin.Language) = """ & Lingo & """)) ORDER BY Ling_Language_Dialogue_List_Latin.Lesson, Ling_Language_Dialogue_List_Latin.Dialogue, Ling_Language_Dialogue_List_Latin.ID;"
0194 End If
0195 Set rs_Temp = Nothing
0196 Else
0197 'Must be Vocab
0198 rs_Temp.MoveFirst
0199 Lingo = rs_Temp.Fields(0)
0200 If rs_Temp.Fields(2) = True Then
0201 'strQuery = "SELECT Ling_Language_Vocab_List_NonLatin.Lesson, Ling_Language_Vocab_List_NonLatin.Item, Ling_Language_Vocab_List_NonLatin.English, Ling_Language_Vocab_List_NonLatin.[Vocabulary Transliteration], Ling_Language_Vocab_List_NonLatin.[English Phrase], Ling_Language_Vocab_List_NonLatin.[Phrase Transliteration], Ling_Language_Vocab_List_NonLatin.Vocabulary, Ling_Language_Vocab_List_NonLatin.Phrase FROM Ling_Language_Vocab_List_NonLatin WHERE (((Ling_Language_Vocab_List_NonLatin.Language) = """ & Lingo & """)) ORDER BY Ling_Language_Vocab_List_NonLatin.Lesson, Ling_Language_Vocab_List_NonLatin.Item;"
0202 strQuery = "SELECT Ling_Language_Vocab_List_NonLatin.Lesson, Ling_Language_Vocab_List_NonLatin.Item, [Ling_Language_Vocab_List_NonLatin]![English] & ""<hr>"" & [Vocabulary Transliteration] & ""<hr>"" & [Vocabulary] AS [Vocabulary Item], [English Phrase] & ""<hr>"" & [Phrase Transliteration] & ""<hr>"" & [Phrase] AS [Phrase Item] FROM Ling_Language_Vocab_List_NonLatin WHERE (((Ling_Language_Vocab_List_NonLatin.Language)=""" & Lingo & """)) ORDER BY Ling_Language_Vocab_List_NonLatin.Lesson, Ling_Language_Vocab_List_NonLatin.Item;"
0203 Else
0204 strQuery = "SELECT Ling_Language_Vocab_List_Latin.Lesson, Ling_Language_Vocab_List_Latin.Item, Ling_Language_Vocab_List_Latin.English, Ling_Language_Vocab_List_Latin.Vocabulary, Ling_Language_Vocab_List_Latin.[English Phrase], Ling_Language_Vocab_List_Latin.Phrase FROM Ling_Language_Vocab_List_Latin WHERE (((Ling_Language_Vocab_List_Latin.Language) = """ & Lingo & """)) ORDER BY Ling_Language_Vocab_List_Latin.Lesson, Ling_Language_Vocab_List_Latin.Item;"
0205 End If
0206 Set rs_Temp = Nothing
0207 End If
0208 Set rs_Temp = CurrentDb.OpenRecordset("SELECT Language_Location_Primer.Language, Language_Location_Primer.Wiki_Language, Language_Location_Primer.Wiki_Script FROM Language_Location_Primer WHERE (((Language_Location_Primer.Ling_Vocab_Note)=Val(" & strParameter2_Local & "))) OR (((Language_Location_Primer.Ling_Dialogue_Note)=Val(" & strParameter2_Local & ")));")
0209 If rs_Temp.EOF Then
0210 Wiki_Lang = 0
0211 Wiki_Script = 0
0212 Language = ""
0213 Else
0214 rs_Temp.MoveFirst
0215 Language = rs_Temp.Fields(0)
0216 Wiki_Lang = rs_Temp.Fields(1)
0217 Wiki_Script = Nz(rs_Temp.Fields(2))
0218 End If
0219 Set rs_Temp = Nothing
0220 End Select
0221 iTotal_Col = 50
0222 Case 23
0223 strQuery = "DELETE * FROM Books_To_Regen;"
0224 DoCmd.RunSQL (strQuery)
0225 DoCmd.OpenQuery ("PID_Books_To_Regen")
0226 strQuery = "PID_Papers_Filed_Not_Referenced"
0227 iTotal_Col = 50
0228 Case 24
0229 strQuery = "PID_Papers_Referenced_Undated"
0230 iTotal_Col = 50
0231 Case 25
0232 strQuery = "PID_Papers_Referenced_No_Abstract"
0233 iTotal_Col = 50
0234 Case 26
0235 strQuery = "Large_Page_List"
0236 iTotal_Col = 50
0237 Case 27
0238 strQuery = "PDF_Missing_List"
0239 iTotal_Col = 50
0240 Case 28
0241 strQuery = "Duplicate_Papers"
0242 iTotal_Col = 50
0243 Case 29
0244 strQuery = "Missing_Webref_DisplayText_List"
0245 iTotal_Col = 50
0246 Case 30
0247 strQuery = "PID_Missing_Online_Papers_List"
0248 iTotal_Col = 50
0249 Case 31
0250 strQuery = "Bible_Reading_Progress"
0251 iTotal_Col = 50
0252 Case 32
0253 strQuery = "Missing_Webref_DisplayText_List_Books"
0254 iTotal_Col = 50
0255 Case 33
0256 strQuery = "PID_Missing_Online_Papers_List_Summary"
0257 iTotal_Col = 5
0258 Case 34
0259 strQuery = "Papers_Inconsistently_Electronic"
0260 iTotal_Col = 50
0261 Case 35
0262 strQuery = "Website_Regen_Control_List"
0263 iTotal_Col = 50
0264 Case 36
0265 strQuery = "BookPaperControl_List"
0266 iTotal_Col = 50
0267 Case 37
0268 strQuery = "Language_Animadversions_XTab_Pri3"
0269 iTotal_Col = 50
0270 Case 38
0271 strQuery = "Language_Animadversions_XTab_Pri4"
0272 iTotal_Col = 50
0273 Case 39
0274 strQuery = "Time_By_Weekday_YTD"
0275 iTotal_Col = 50
0276 Case 40
0277 strQuery = "Time_By_Weekday_QTD"
0278 iTotal_Col = 50
0279 Case 41
0280 strQuery = "Ling_Dodgy_Vocab"
0281 iTotal_Col = 50
0282 Case 42
0283 Select Case strParameter2_Local
0284 Case 1
0285 strQuery = "Day_Plan_M1"
0286 Case 2
0287 strQuery = "Day_Plan_M2"
0288 Case 3
0289 strQuery = "Day_Plan_M3"
0290 End Select
0291 iTotal_Col = 50
0292 Case 43
0293 strQuery = "Journals_List"
0294 iTotal_Col = 50
0295 Case 44
0296 strQuery = "LRB_XTab"
0297 iTotal_Col = 50
0298 Case 45
0299 strQuery = "LRB_Files_List"
0300 iTotal_Col = 50
0301 Case Else
0302 Exit Function
0303End Select
0304strTable_Local = ""
0305j = 0
0306For i = 1 To 100
0307 k(i) = 0
0308Next i
0309Set rs = CurrentDb.OpenRecordset(strQuery)
0310If rs.EOF Then
0311 Debug.Print Now(); "- Functor_21, Option " & strParameter & " - Query: """ & strQuery; """ : No table to print."
0312 Functor_21 = "Yes"
0313 strTable = "|##||.|No items to display.|##|"
0314 Exit Function
0315Else
0316 'To correct Error 3047 - Record is too large ... >4k
0317 On Error Resume Next
0318 rs.MoveLast
0319 Err.Clear
0320 iCols = rs.Fields.Count
0321 If iTotal_Col = 0 Then
0322 iTotal_Col = iCols
0323 End If
0324 rs.MoveFirst
0325End If
0326'Check for empty table for Daily Task List
0327If strParameter = 42 Then
0328 rs.MoveFirst
0329 Do Until rs.EOF
0330 If rs.Fields(1) = "Counts" Then
0331 If rs.Fields(2) = 0 Then
0332 Functor_21 = "Yes"
0333 strTable = ""
0334 Exit Function
0335 End If
0336 End If
0337 rs.MoveNext
0338 Loop
0339 rs.MoveFirst
0340End If
0341'Set up Table Header
0342Select Case strParameter
0343 Case 3, 31
0344 strElement = "<table width=1700 class = ""ReadingList"">"
0345 Case 43, 44, 45
0346 strElement = "<table width=1850 class = ""ReadingList"">"
0347 Case 15, 17, 18, 23, 24, 25, 28, 29, 30, 32
0348 strElement = "<table width=1500 class = ""ReadingList"">"
0349 Case 42
0350 strElement = "<br><br><table width=1800 class = ""Bridge"">"
0351 Case 7, 8, 26, 27, 34
0352 strElement = "<table width=1000 class = ""ReadingList"">"
0353 Case 22
0354 strElement = ""
0355 If Wiki_Lang = 0 Then
0356 If Wiki_Script = 0 Then
0357 Else
0358 strElement = "+W" & Wiki_Script & "W+"
0359 End If
0360 Else
0361 strElement = "+W" & Wiki_Lang & "W+"
0362 If Wiki_Script = 0 Then
0363 Else
0364 strElement = strElement & " &larr;&rarr; +W" & Wiki_Script & "W+"
0365 End If
0366 End If
0367 'Set up a jump table
0368 strElement = strElement & "<br><br><u><b>Lesson Jump Table</b></u><br><table width=600 class = ""ReadingList""><br>"
0369 For i = 1 To 5
0370 If i > 1 Then
0371 strElement = strElement & "</tr>"
0372 End If
0373 strElement = strElement & "<tr>"
0374 For j = 1 To 10
0375 strElement = strElement & "<th class = ""BridgeCenter""><a href = #" & 10 * (i - 1) + j & ">" & 10 * (i - 1) + j & "</a></th>"
0376 Next j
0377 Next i
0378 strElement = strElement & "</tr></table><a name=1></a><br><u><b>" & Language & " - Lesson: 1</b></u>"
0379 strLesson = "Lesson: "
0380 strTable_Saved = "<br><br><table width=500 class = ""ReadingList"">"
0381 strElement = strElement & strTable_Saved
0382 Case 11, 31
0383 strElement = "<table width=1200 class = ""ReadingList"">"
0384 Case 12, 13, 37, 38
0385 strElement = "<table width=1200 class = ""Bridge"">"
0386 Case 20
0387 Select Case strParameter2_Local
0388 Case 1, 2, 3, 4
0389 strElement = "<table width=1200 class = ""Bridge"">"
0390 Case 5
0391 strElement = "<table width=600 class = ""Bridge"">"
0392 End Select
0393 Case 21
0394 strElement = "<table width=2400 class = ""Bridge"">"
0395 If strParameter2_Local > 5 Then
0396 strElement = "<table width=600 class = ""Bridge"">"
0397 End If
0398 If strParameter2_Local > 7 Then
0399 strElement = "<table width=1200 class = ""Bridge"">"
0400 End If
0401 If strParameter2_Local = 10 Then
0402 strElement = "<table width=900 class = ""Bridge"">"
0403 End If
0404 strTable_Saved = strElement 'Save for later
0405 Select Case strParameter2_Local
0406 Case 3, 4, 5, 7, 8, 10
0407 'Set up a jump table by lesson
0408 strElement = "<u><b>Lesson Jump Table</b></u><br><table width=600 class = ""ReadingList""><br>"
0409 For i = 1 To 5
0410 If i > 1 Then
0411 strElement = strElement & "</tr>"
0412 End If
0413 strElement = strElement & "<tr>"
0414 For j = 1 To 10
0415 strElement = strElement & "<th class = ""BridgeCenter""><a href = #" & 10 * (i - 1) + j & ">" & 10 * (i - 1) + j & "</a></th>"
0416 Next j
0417 Next i
0418 strElement = strElement & "</tr></table><a name=1></a><br><u><b>Lesson: 1</b></u>"
0419 strLesson = "Lesson: "
0420 strElement = strElement & "<br><br>" & strTable_Saved
0421 Case Else
0422 'Set up a jump table by Category
0423 strQuery2 = "SELECT Ling_English_Category_Extras.Category FROM Ling_English_Category_Extras GROUP BY Ling_English_Category_Extras.Category ORDER BY Ling_English_Category_Extras.Category;"
0424 Set rs_Temp = CurrentDb.OpenRecordset(strQuery2)
0425 If Not rs_Temp.EOF Then
0426 strElement = "<u><b>Category Jump Table</b></u><br><br><table width=800 class = ""ReadingList""><tr>"
0427 rs_Temp.MoveFirst
0428 For i = 1 To 4
0429 If i > 1 Then
0430 strElement = strElement & "</tr>"
0431 End If
0432 strElement = strElement & "<tr>"
0433 For j = 1 To 7
0434 strElement = strElement & "<th class = ""BridgeCenter""><a href = #" & Replace(rs_Temp.Fields(0), " / ", "") & ">" & Replace(rs_Temp.Fields(0), " ", "") & "</a></th>"
0435 If Not rs_Temp.EOF Then
0436 rs_Temp.MoveNext
0437 Else
0438 strElement = strElement & "<th class = ""BridgeCenter"">&nbsp;</th>"
0439 End If
0440 Next j
0441 Next i
0442 rs_Temp.MoveFirst
0443 strElement = strElement & "</tr></table><a name=" & rs_Temp.Fields(0) & "></a><br><u><b>" & rs_Temp.Fields(0) & "</b></u>"
0444 End If
0445 strElement = strElement & "<br><br>" & strTable_Saved
0446 Set rs_Temp = Nothing
0447 strLesson = ""
0448 End Select
0449 Case 39, 40
0450 strElement = "<table width=500 class = ""Bridge"">"
0451 Case Else
0452 strElement = "<table width=900 class = ""Bridge"">"
0453End Select
0454strTable_Local = strTable_Local & strElement
0455'Set up Table Headings
0456strElement = "<tr>"
0457For i = 1 To iCols
0458 strCell = rs.Fields(i - 1).Name
0459 Select Case strParameter
0460 Case 3
0461 If i = 1 Then
0462 strElement = strElement & "<th class = ""BridgeLeft"">" & strCell & "</th>"
0463 Else
0464 strElement = strElement & "<th class = ""BridgeCenter"">" & strCell & "</th>"
0465 End If
0466 Case 7
0467 If i = 1 Or i = 5 Then
0468 strElement = strElement & "<th class = ""BridgeLeft"">" & strCell & "</th>"
0469 Else
0470 strElement = strElement & "<th class = ""BridgeCenter"">" & strCell & "</th>"
0471 End If
0472 Case 8
0473 If i = 1 Or i = 2 Then
0474 strElement = strElement & "<th class = ""BridgeLeft"">" & strCell & "</th>"
0475 Else
0476 strElement = strElement & "<th class = ""BridgeCenter"">" & strCell & "</th>"
0477 End If
0478 Case 11
0479 If i = 4 Then
0480 strElement = strElement & "<th class = ""BridgeLeft"">" & strCell & "</th>"
0481 Else
0482 strElement = strElement & "<th class = ""BridgeCenter"">" & strCell & "</th>"
0483 End If
0484 Case 15, 17, 18, 23, 24, 25, 27, 28, 29, 30, 32, 34
0485 strElement = strElement & "<th class = ""BridgeLeft"">" & strCell & "</th>"
0486 Case 20
0487 Col_Width = Round(100 / iCols, 1)
0488 strElement = strElement & "<th width = """ & Col_Width & "%"" align = ""Center"">" & strCell & "</th>"
0489 Case 21
0490 Select Case strParameter2_Local
0491 Case 1, 4, 6 'Case 7 moved to next list 06/07/24
0492 If i > 2 Then
0493 strCell = Mid(strCell, 4)
0494 End If
0495 Case 2, 5, 7, 8, 9
0496 If i > 3 Then
0497 strCell = Mid(strCell, 4)
0498 End If
0499 Case 3, 10
0500 If i > 5 Then
0501 strCell = Mid(strCell, 4)
0502 End If
0503 End Select
0504 strElement = strElement & "<th>" & strCell & "</th>"
0505 Case 22
0506 If i = 2 Or i = 3 Then
0507 strElement = strElement & "<th class = ""BridgeCenter"">" & strCell & "</th>"
0508 Else
0509 strElement = strElement & "<th class = ""BridgeLeft"">" & strCell & "</th>"
0510 End If
0511 Case 26
0512 strElement = strElement & "<th class = ""BridgeCenter"">" & strCell & "</th>"
0513 Case 31, 43, 44, 45
0514 strElement = strElement & "<th class = ""BridgeLeft"">" & strCell & "</th>"
0515 Case 42
0516 Select Case i
0517 Case 1
0518 strElement = strElement & "<th class = ""BridgeCenter"">" & "&nbsp;" & "</th>"
0519 Case 2
0520 strElement = strElement & "<th class = ""BridgeLeft"">" & strCell & "</th>"
0521 Case iCols
0522 strElement = strElement & "<th class = ""BridgeLeft"">" & Left(strCell, Len(strCell) - 1) & "</th>"
0523 Case Else
0524 strElement = strElement & "<th class = ""BridgeCenter"">" & strCell & "</th>"
0525 End Select
0526 Case Else
0527 strElement = strElement & "<th>" & strCell & "</th>"
0528 End Select
0529 If i = iTotal_Col And strParameter <> 3 Then
0530 strElement = strElement & "<th>TOTAL</th>"
0531 End If
0532Next i
0533strElement = strElement & "</tr>"
0534strHeader = strElement & Chr$(10)
0535If strParameter = 30 Or strParameter = 30 Then 'Err .... ********************
0536 strElement = ""
0537End If
0538strTable_Local = strTable_Local & strElement & Chr$(10)
0539'Set up Table Rows
0540strCell_1_Saved = ""
0541strCell_4_Saved = ""
0542strElement = ""
0543Do Until rs.EOF
0544 If strParameter = 11 Or strParameter = 22 Or strParameter = 21 Then
0545 If (strCell_1_Saved <> rs.Fields(0)) And (strElement <> "") Then
0546 If strParameter = 21 Or strParameter = 22 Then
0547 'Close previous table
0548 strElement = strElement & strHeader 'Repeat the column headersstrParameter2_Local
0549 strElement = strElement & "</table><a name=""" & Replace(rs.Fields(0), " / ", "") & """</a><br><br><u><b>" & IIf(strParameter = 21, "", Language & " - ") & strLesson & rs.Fields(0) & "</b></u>"
0550 'Open a new table
0551 strElement = strElement & strTable_Saved
0552 Else
0553 'Insert a blank row
0554 strElement = strElement & "<tr>"
0555 For i = 1 To iCols
0556 strElement = strElement & "<td>&nbsp;</td>"
0557 Next i
0558 strElement = strElement & "</tr>"
0559 End If
0560 'Insert the header row
0561 strElement = strElement & strHeader
0562 End If
0563 End If
0564 j = 0
0565 For i = 1 To iCols
0566 strCell = ""
0567 Select Case i
0568 Case 1
0569 strWork = "<tr>"
0570 strCell = rs.Fields(0) & ""
0571 If strParameter = 7 Or strParameter = 8 Or strParameter = 11 Or strParameter = 22 Or strParameter = 24 Or strParameter = 30 Or strParameter = 21 Then
0572 If (strCell_1_Saved = strCell) And strCell & "" <> "" Then
0573 strCell = "&uarr;&uarr;&uarr;"
0574 Else
0575 strCell_1_Saved = strCell
0576 If strParameter = 11 Or strParameter = 22 Then
0577 strCell = "+R" & strCell & IIf(strParameter = 22 And Val(strParameter2_Local) > 2, "Dialogue", "") & "R+" & "<b>" & strCell & "</b>"
0578 Else
0579 If strParameter = 30 Then
0580 strWork = Mid(strCell, 2, InStr(strCell, "]") - 2)
0581 strWork = "PDFs_" & Replace(strWork, " ", "")
0582 strWork = Left(strWork, 20)
0583 strWork = "</table><br><br>+R" & strWork & "R+<table width=1500 class = ""ReadingList"">" & strHeader & "<tr>"
0584 End If
0585 End If
0586 End If
0587 If (strParameter = 11 And rs.Fields(1) <> 0) Or strParameter = 22 Then
0588 strCell = "+R" & rs.Fields(1) & IIf(strParameter = 22 And Val(strParameter2_Local) > 2, "Dialogue", "") & "R+ " & strCell
0589 End If
0590 strElement = strElement & strWork & "<td class = ""BridgeLeft"">" & strCell & "</td>"
0591 Else
0592 strElement = strElement & strWork
0593 If strParameter = 3 Or strParameter = 26 Or strParameter = 27 Or strParameter = 28 Or strParameter = 29 Or strParameter = 32 Or strParameter = 34 Then
0594 If strParameter = 26 Then
0595 strCell = "..\..\" & strCell
0596 strWork2 = Link_Narr_Gen(strCell) & ""
0597 If strWork2 = "" Then
0598 strWork2 = strCell
0599 End If
0600 strCell = "<a href=""" & strCell & """>" & strWork2 & "</a>"
0601 strElement = strElement & "<td class = ""BridgeRight"">" & strCell & "</td>"
0602 Else
0603 strElement = strElement & "<td class = ""BridgeLeft"">" & strCell & "</td>"
0604 End If
0605 Else
0606 If strParameter = 15 Or strParameter = 17 Or strParameter = 18 Or strParameter = 23 Or strParameter = 24 Or strParameter = 25 Or strParameter = 30 Or strParameter = 31 Or strParameter = 43 Or strParameter = 44 Or strParameter = 45 Then
0607 strElement = strElement & "<td class = ""BridgeLeft"">" & strCell & "</td>"
0608 Else
0609 strElement = strElement & "<td>" & strCell & "</td>"
0610 End If
0611 End If
0612 End If
0613 Case Else
0614 strCell = rs.Fields(i - 1) & ""
0615 If Len(strCell) = 0 Then
0616 strCell = "&nbsp;"
0617 Else
0618 If strParameter = 3 Then
0619 If i > 6 Then
0620 strCell = Round(strCell, 2)
0621 End If
0622 End If
0623 If i <= iTotal_Col Then
0624 j = j + Val(strCell)
0625 End If
0626 k(i) = k(i) + Val(strCell)
0627 If strParameter <> 3 And strParameter <> 26 And strParameter <> 28 And strParameter <> 29 And strParameter <> 32 Then
0628 OK = Number_Format(strCell)
0629 End If
0630 End If
0631 If (i = 5 And strParameter = 7) Or (i = 2 And strParameter = 15) Or (i = 2 And strParameter = 17) Or (i = 2 And strParameter = 18) Then
0632 If strCell_4_Saved = strCell Then
0633 strCell = "&uarr;&uarr;&uarr;"
0634 Else
0635 strCell_4_Saved = strCell
0636 End If
0637 End If
0638 If i = 3 And strParameter = 3 Then
0639 If strCell = "-" Then
0640 strCell = "&nbsp;"
0641 Else
0642 strCell = Oboe_File_Links_List(strCell)
0643 End If
0644 End If
0645 If (strParameter = 3 And i > 1) Or (strParameter = 7 And i < 5) Or (strParameter = 8 And i > 2) Or (strParameter = 11 And i < 4) Then
0646 strElement = strElement & "<td class=""BridgeCenter"">" & strCell & "</td>"
0647 Else
0648 If strParameter = 11 And i = 4 Then
0649 If rs.Fields(1) = "0" Then
0650 strCell = "<b>Administration</b>|..||.|" & strCell & ": " & Language_Animadversion_Reference_List(rs.Fields(0))
0651 'Add old time
0652 strCell = strCell & Subject_Hours_List(rs.Fields(0))
0653 strQuery = "SELECT Language_Location_Primer.Language_Key, Language_Location_Primer.Ling_Progress, Language_Location_Primer.Ling_Vocab_Note, Language_Location_Primer.Ling_Dialogue_Note, Language_Location_Primer.Wiki_Language, Language_Location_Primer.Wiki_Script FROM Language_Location_Primer WHERE (((Language_Location_Primer.Language_Key)=""" & rs.Fields(0) & """));"
0654 Set rs_Temp = CurrentDb.OpenRecordset(strQuery)
0655 rs_Temp.MoveFirst
0656 If rs_Temp.Fields(1) > 0 Then
0657 'Add latest Ling Lesson
0658 strCell = strCell & "|.|<b>Latest Ling Lesson Studied: </b>" & rs_Temp.Fields(1)
0659 'Add Links to Ling XTabs
0660 strCell = strCell & "|.|<b>Links to Aeon Comparative Database: </b>|99|"
0661 strCell = strCell & "|1|Vocabulary++" & rs_Temp.Fields(2) & "++|1|Dialogues++" & rs_Temp.Fields(3) & "++"
0662 strCell = strCell & "|99|"
0663 End If
0664 If rs_Temp.Fields(4) > 0 Then
0665 strCell = strCell & "|.|+W" & rs_Temp.Fields(4) & "W+"
0666 End If
0667 If rs_Temp.Fields(5) > 0 Then
0668 strCell = strCell & "|.|+W" & rs_Temp.Fields(5) & "W+"
0669 End If
0670 'Finish off
0671 Set rs_Temp = Nothing
0672 strCell = strCell & "|..|"
0673 Else
0674 strCell = Language_Animadversion_Translate(strCell, rs.Fields(0))
0675 End If
0676 End If
0677 If (strParameter = 7 And i = 5) Or (strParameter = 8 And i = 2) Or (strParameter = 11 And i = 4) Or strParameter = 15 Or strParameter = 17 Or strParameter = 18 Or strParameter = 22 Or strParameter = 30 Or (strParameter = 21 And (Val(strParameter2_Local) <> 3)) Then
0678 strElement = strElement & "<td class=""BridgeLeft"">" & strCell & "</td>"
0679 Else
0680 If strParameter = 23 Then
0681 If i = 2 Or i = 4 Or i = 7 Then
0682 strElement = strElement & "<td class=""BridgeLeft"">" & strCell & "</td>"
0683 Else
0684 strElement = strElement & "<td class=""BridgeCenter"">" & strCell & "</td>"
0685 End If
0686 Else
0687 If strParameter = 24 Or strParameter = 25 Or strParameter = 28 Or strParameter = 29 Or strParameter = 31 Or strParameter = 32 Or strParameter = 44 Or strParameter = 45 Then
0688 strElement = strElement & "<td class=""BridgeLeft"">" & strCell & "</td>"
0689 Else
0690 If strParameter = 26 Then
0691 Select Case i
0692 Case 2, 3
0693 strElement = strElement & "<td class=""BridgeCenter"">" & strCell & "</td>"
0694 Case 4
0695 OK = Number_Format(strCell)
0696 strElement = strElement & "<td class=""BridgeRight"">" & strCell & "</td>"
0697 Case 5
0698 strCell = "&nbsp;"
0699 m = InStr(rs.Fields(0), "NotesPrint_")
0700 If m > 0 Then
0701 m = m + 11
0702 n = InStr(m, rs.Fields(0), "_")
0703 If n > 0 Then
0704 m = Mid(rs.Fields(0), m, n - m)
0705 strCell = "[Note Link]++" & m & "++"
0706 End If
0707 End If
0708 strElement = strElement & "<td class=""BridgeLeft"">" & strCell & "</td>"
0709 End Select
0710 Else
0711 If strParameter = 43 Then
0712 Select Case i
0713 Case 3, 5
0714 strElement = strElement & "<td class=""BridgeCenter"">" & strCell & "</td>"
0715 Case Else
0716 strElement = strElement & "<td class=""BridgeLeft"">" & strCell & "</td>"
0717 End Select
0718 Else
0719 strElement = strElement & "<td format="","">" & strCell & "</td>"
0720 End If
0721 End If
0722 End If
0723 End If
0724 End If
0725 End If
0726 If i = iTotal_Col Then
0727 'Row Total
0728 strCell = j
0729 If strParameter <> 3 Then
0730 OK = Number_Format(strCell)
0731 strElement = strElement & "<th>" & strCell & "</th>"
0732 End If
0733 k(iCols + 1) = k(iCols + 1) + j
0734 End If
0735 End Select
0736 Next i
0737 strElement = strElement & "</tr>" & Chr$(10)
0738 rs.MoveNext
0739Loop
0740strTable_Local = strTable_Local & strElement
0741'Set up Total Line
0742If iCols >= iTotal_Col Then 'Allow for no Total Row
0743 If strParameter = 3 Then
0744 strElement = "<tr><th class=""BridgeCenter"">TOTALS &rarr;</th>"
0745 Else
0746 strElement = "<tr><th>TOTAL</th>"
0747 End If
0748 For i = 2 To iCols
0749 strCell = k(i)
0750 If strParameter <> 3 Then
0751 OK = Number_Format(strCell)
0752 End If
0753 If strCell = 0 Then
0754 strCell = "&nbsp;"
0755 End If
0756 If strParameter = 3 Then
0757 If i < 5 Then
0758 strElement = strElement & "<th class=""BridgeCenter"">" & "&nbsp;" & "</th>"
0759 Else
0760 strElement = strElement & "<th class=""BridgeCenter"">" & strCell & "</th>"
0761 End If
0762 Else
0763 strElement = strElement & "<th>" & strCell & "</th>"
0764 If i = iTotal_Col Then
0765 strCell = k(iCols + 1)
0766 OK = Number_Format(strCell)
0767 strElement = strElement & "<th>" & strCell & "</th>"
0768 End If
0769 End If
0770 Next i
0771 strElement = strElement & "<tr>" & Chr$(10)
0772 strTable_Local = strTable_Local & strElement
0773End If
0774'Set up Table Footer
0775If strParameter = 3 Or strParameter = 11 Or strParameter = 22 Or (strParameter = 21 And (Val(strParameter2_Local) <> 3)) Then
0776 strTable_Local = strTable_Local & strHeader 'Repeat the column headers
0777End If
0778strElement = "</table>"
0779strTable_Local = strTable_Local & strElement
0780'Tidy up and exit
0781Functor_21 = "Yes"
0782strTable = strTable_Local
0783Set rs = Nothing
0784End Function

Procedures Calling This Procedure (Functor_21) Procedures Called By This Procedure (Functor_21) Tables / Queries / Fragments Directly Used By This Procedure (Functor_21) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: Functor_22
Procedure Type: Public Function
Module: Functors
Lines of Code: 403
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Functor_22(strParameter, strList, Note_ID, str_Parameter_2, Optional str_Parameter_3, Optional str_Parameter_4) 'str_Parameter_3 & _4 to be used for recursion
0002'This function formats a list (together with surrounding narrative) from a query
0003Dim rs As Recordset
0004Dim strList_Local As String
0005Dim strElement As String
0006Dim strCell As String
0007Dim strQuery As String
0008Dim strUpdtQuery As String
0009Dim BP As String
0010Dim FN As String
0011Dim str_Parameter_2_Local As String
0012Dim str_Parameter_3_Local As String
0013Dim str_Parameter_4_Local As String
0014Dim strPara2 As String
0015Dim strPara3 As String
0016Dim Item_Year As String
0017Dim Write_Up_Note As Long
0018Dim Field_1 As String
0019Dim Field_2 As String
0020Dim Field_3 As String
0021Dim Field_4 As String
0022Dim Chapter_FieldName As String
0023Dim iCols As Integer
0024str_Parameter_2_Local = str_Parameter_2 & ""
0025If IsMissing(str_Parameter_3) Then
0026 str_Parameter_3_Local = ""
0027Else
0028 str_Parameter_3_Local = str_Parameter_3 & ""
0029End If
0030If IsMissing(str_Parameter_4) Then
0031 str_Parameter_4_Local = ""
0032Else
0033 str_Parameter_4_Local = str_Parameter_4 & ""
0034End If
0035strPara3 = ""
0036'For Cases 6 to 7 ... Note that this processing is performed for cases 8 & 9 on re-entry
0037If strParameter >= 6 And strParameter <= 7 Then
0038 If automatic_processing <> "Yes" Then
0039 'Check Books & Papers on PID_Note_Reading_Lists exist!
0040 Set rs = CurrentDb.OpenRecordset("PID_Note_Reading_Lists_Books_Chk")
0041 If Not rs.EOF Then
0042 DoCmd.OpenQuery ("PID_Note_Reading_Lists_Books_Chk")
0043 End If
0044 Set rs = Nothing
0045 Set rs = CurrentDb.OpenRecordset("PID_Note_Reading_Lists_Papers_Chk")
0046 If Not rs.EOF Then
0047 DoCmd.OpenQuery ("PID_Note_Reading_Lists_Papers_Chk")
0048 End If
0049 Set rs = Nothing
0050 'Add new rows to PID_Note_Reading_Lists
0051 DoCmd.OpenQuery ("PID_Notes_Books_Referenced_Gen")
0052 DoCmd.OpenQuery ("PID_Notes_Papers_Referenced_Gen")
0053 DoCmd.OpenQuery ("IdentityBooks_Unreferenced_Gen")
0054 DoCmd.OpenQuery ("IdentityPapersRead_Unreferenced_Gen")
0055 ' Update/add the authors, titles and the "read" & "annotation" status of the papers on PID_Note_Reading_Lists
0056 strUpdtQuery = "UPDATE PID_Note_Reading_Lists INNER JOIN Papers ON PID_Note_Reading_Lists.Called_ID = Papers.ID SET PID_Note_Reading_Lists.[Percent_Read] = Papers.[Actual - Total] / Papers.Estimate * 100, PID_Note_Reading_Lists.[Read?] = [Papers]![Read?], PID_Note_Reading_Lists.Author = [Papers]![Author], PID_Note_Reading_Lists.Title = [Papers]![Title], PID_Note_Reading_Lists.[Annotations?] = [Papers]![Annotations?], PID_Note_Reading_Lists.[Abstract_Null?] = IIf([Abstract] & """"="""",True,False), PID_Note_Reading_Lists.[Link_Internal?] = IIf(InStr([Comments] & """",""+F"")>0,True,False), PID_Note_Reading_Lists.[Link_External?] = IIf(InStr([Comments] & """",""+W"")>0,True,False) WHERE (((PID_Note_Reading_Lists.[Book/Paper])=""Paper"") AND ((PID_Note_Reading_Lists.Note_ID)=" & Note_ID & "));"
0057 DoCmd.RunSQL (strUpdtQuery)
0058 ' Update/add the authors, titles and the "read" status of the books on PID_Note_Reading_Lists
0059 strUpdtQuery = "UPDATE PID_Note_Reading_Lists INNER JOIN Books ON PID_Note_Reading_Lists.Called_ID = Books.ID1 SET PID_Note_Reading_Lists.[Percent_Read] = Books.[Actual - Total] / Books.Estimate * 100, PID_Note_Reading_Lists.[Read?] = [Books]![Read?], PID_Note_Reading_Lists.Author = [Books]![Author], PID_Note_Reading_Lists.Title = [Books]![Title] WHERE (((PID_Note_Reading_Lists.[Book/Paper])=""Book"") AND ((PID_Note_Reading_Lists.Note_ID)=" & Note_ID & "));"
0060 DoCmd.RunSQL (strUpdtQuery)
0061 'Update to show Write-up Notes
0062 strUpdtQuery = "UPDATE PID_Note_Reading_Lists INNER JOIN Papers ON PID_Note_Reading_Lists.Called_ID = Papers.ID SET PID_Note_Reading_Lists.[Write-Up?] = [Papers]![Write_Up_Note_ID] WHERE (((Papers.Write_Up_Note_ID)>0) AND ((PID_Note_Reading_Lists.[Book/Paper])=""Paper"") AND ((PID_Note_Reading_Lists.Note_ID)=" & Note_ID & "));"
0063 DoCmd.RunSQL (strUpdtQuery)
0064 End If
0065 'Check if R/L to be de-duplicated
0066 If str_Parameter_3_Local = "De-Duplicate" Then
0067 'Determine the column name in PID_Note_Reading_Lists table
0068 strQuery = "SELECT Thesis_Chapters.ID, Thesis_Chapters.Chapter FROM Thesis_Chapters WHERE (((Thesis_Chapters.ID)=" & str_Parameter_4 & "));"
0069 Set rs = CurrentDb.OpenRecordset(strQuery)
0070 If Not rs.EOF Then
0071 rs.MoveFirst
0072 Chapter_FieldName = rs.Fields(1)
0073 Chapter_FieldName = "Ch_" & Chapter_FieldName & "_Ist_Note"
0074 strPara3 = " AND ((PID_Note_Reading_Lists." & Chapter_FieldName & ")<>999999)"
0075 End If
0076 Set rs = Nothing
0077 End If
0078End If
0079'For Cases 6 to 9 ...
0080If strParameter >= 6 And strParameter <= 9 Then
0081 'Over-ride Parameter_2 (Category) if requested, else select only that Category
0082 If str_Parameter_2_Local = "*ALL*" Then
0083 strPara2 = ""
0084 Else
0085 If str_Parameter_2_Local = "" Then
0086 strPara2 = " AND ((PID_Note_Reading_Lists.Category) & """" = """")"
0087 Else
0088 strPara2 = " AND ((PID_Note_Reading_Lists.Category)=""" & str_Parameter_2_Local & """)"
0089 End If
0090 End If
0091 'Adjust for items that have missed the cut
0092 If str_Parameter_3_Local = "" Then
0093 strPara3 = ""
0094 Else
0095 If str_Parameter_3_Local = "1" Or str_Parameter_3_Local = "De-Duplicate" Then
0096 strPara3 = " AND ((PID_Note_Reading_Lists.[Missed_Cut?]) = False)"
0097 Else
0098 strPara3 = " AND ((PID_Note_Reading_Lists.[Missed_Cut?]) = True)"
0099 End If
0100 End If
0101End If
0102Select Case strParameter
0103 Case 1
0104 strQuery = "Cross_Reference_By_Year"
0105 strElement = "However, there are (as of " & Now() & ", using +CFunctor_22C+ & query +QCross_Reference_By_YearQ+) the following counts of records on the table with timestamps in the years below:- "
0106 Case 2
0107 strQuery = "Cross_Reference_Changes_By_Year"
0108 strElement = ""
0109 Case 3
0110 DoCmd.OpenQuery ("Functor_Descriptions_GEN")
0111 strQuery = "Functor_Descriptions_List"
0112 strElement = ""
0113 Case 4
0114 strQuery = "Cross_Reference_Changes_By_Month"
0115 strElement = ""
0116 Case 5
0117 strQuery = "PID_Notes_Unused_By_Thesis"
0118 strElement = ""
0119 Case 6
0120 strQuery = "SELECT PID_Note_Reading_Lists.[Book/Paper], PID_Note_Reading_Lists.Called_ID, PID_Note_Reading_Lists.Footnote, PID_Note_Reading_Lists.Author, PID_Note_Reading_Lists.Title, PID_Note_Reading_Lists.Item_Year, PID_Note_Reading_Lists.[Write-Up?], PID_Note_Reading_Lists.[Annotations?], PID_Note_Reading_Lists.[Abstract_Null?], PID_Note_Reading_Lists.[Link_External?], PID_Note_Reading_Lists.[Link_Internal?], PID_Note_Reading_Lists.[Percent_Read], PID_Note_Reading_Lists.[Reason_Missed_Cut] FROM PID_Note_Reading_Lists WHERE (((PID_Note_Reading_Lists.Note_ID) = " & Note_ID & ") And ((PID_Note_Reading_Lists.[Read?]) = Yes) And ((PID_Note_Reading_Lists.[Suppress?]) = No)" & strPara2 & strPara3 & ") ORDER BY PID_Note_Reading_Lists.Author, PID_Note_Reading_Lists.Title;"
0121 strElement = ""
0122 Case 7
0123 strQuery = "SELECT PID_Note_Reading_Lists.[Book/Paper], PID_Note_Reading_Lists.Called_ID, PID_Note_Reading_Lists.Footnote, PID_Note_Reading_Lists.Author, PID_Note_Reading_Lists.Title, PID_Note_Reading_Lists.Item_Year, PID_Note_Reading_Lists.[Write-Up?], PID_Note_Reading_Lists.[Annotations?], PID_Note_Reading_Lists.[Abstract_Null?], PID_Note_Reading_Lists.[Link_External?], PID_Note_Reading_Lists.[Link_Internal?], PID_Note_Reading_Lists.[Percent_Read], PID_Note_Reading_Lists.[Reason_Missed_Cut] FROM PID_Note_Reading_Lists WHERE (((PID_Note_Reading_Lists.Note_ID) = " & Note_ID & ") And ((PID_Note_Reading_Lists.[Read?]) = No) And ((PID_Note_Reading_Lists.[Suppress?]) = No)" & strPara2 & strPara3 & ") ORDER BY PID_Note_Reading_Lists.Author, PID_Note_Reading_Lists.Title;"
0124 strElement = ""
0125 Case 8
0126 If str_Parameter_2_Local = "" Then
0127 strQuery = "SELECT PID_Note_Reading_Lists.Category FROM PID_Note_Reading_Lists WHERE (((PID_Note_Reading_Lists.Note_ID) = " & Note_ID & ") And ((PID_Note_Reading_Lists.[Suppress?]) = No) " & strPara3 & " And ((PID_Note_Reading_Lists.[Read?]) = Yes)) GROUP BY PID_Note_Reading_Lists.Category ORDER BY PID_Note_Reading_Lists.Category;"
0128 Else
0129 strQuery = "SELECT Mid([Category],Len(""" & str_Parameter_2_Local & """)+1) AS Expr2 FROM PID_Note_Reading_Lists WHERE (((PID_Note_Reading_Lists.Note_ID) = " & Note_ID & ") And ((PID_Note_Reading_Lists.[Suppress?]) = No) " & strPara3 & " And ((PID_Note_Reading_Lists.[Read?]) = Yes) And ((Left([Category], Len(""" & str_Parameter_2_Local & """))) = """ & str_Parameter_2_Local & """)) GROUP BY Mid([Category],Len(""" & str_Parameter_2_Local & """)+1) ORDER BY Mid([Category],Len(""" & str_Parameter_2_Local & """)+1);"
0130 End If
0131 strElement = ""
0132 Case 9
0133 If str_Parameter_2_Local = "" Then
0134 strQuery = "SELECT PID_Note_Reading_Lists.Category FROM PID_Note_Reading_Lists WHERE (((PID_Note_Reading_Lists.Note_ID) = " & Note_ID & ") And ((PID_Note_Reading_Lists.[Suppress?]) = No) " & strPara3 & " And ((PID_Note_Reading_Lists.[Read?]) = No)) GROUP BY PID_Note_Reading_Lists.Category ORDER BY PID_Note_Reading_Lists.Category;"
0135 Else
0136 strQuery = "SELECT Mid([Category],Len(""" & str_Parameter_2_Local & """)+1) AS Expr2 FROM PID_Note_Reading_Lists WHERE (((PID_Note_Reading_Lists.Note_ID) = " & Note_ID & ") And ((PID_Note_Reading_Lists.[Suppress?]) = No) " & strPara3 & " And ((PID_Note_Reading_Lists.[Read?]) = No) And ((Left([Category], Len(""" & str_Parameter_2_Local & """))) = """ & str_Parameter_2_Local & """)) GROUP BY Mid([Category],Len(""" & str_Parameter_2_Local & """)+1) ORDER BY Mid([Category],Len(""" & str_Parameter_2_Local & """)+1);"
0137 End If
0138 strElement = ""
0139 Case 10
0140 If str_Parameter_2_Local = "Read" Then
0141 strPara2 = "((Functor_Usage.Functor_Option)=6 Or (Functor_Usage.Functor_Option)=8) "
0142 Else
0143 strPara2 = "((Functor_Usage.Functor_Option)=7 Or (Functor_Usage.Functor_Option)=9) "
0144 End If
0145 strQuery = "SELECT Thesis_Note_XRef.Thesis_Chapter_Note_ID, Thesis_Note_XRef.PID_Note_Seq, Thesis_Note_XRef.PID_Note_Category_1, Thesis_Note_XRef.PID_Note_Category_2, Thesis_Note_XRef.PID_Note_Category_3, Thesis_Note_XRef.PID_Note_Level, Thesis_Note_XRef.PID_Note_ID, Thesis_Note_XRef.PID_Note_Caption, Functor_Usage.Functor_Option, Functor_Usage.Functor_Parameter FROM Thesis_Note_XRef INNER JOIN Functor_Usage ON Thesis_Note_XRef.PID_Note_ID = Functor_Usage.Note_ID WHERE (" & strPara2 & " And ((Functor_Usage.Functor_ID) = 22) And ((Thesis_Note_XRef.Thesis_Chapter_Note_ID) = " & Note_ID & ") And ((Thesis_Note_XRef.[Exclude?]) = No)) ORDER BY Thesis_Note_XRef.PID_Note_Seq, Thesis_Note_XRef.PID_Note_Category_1, Thesis_Note_XRef.PID_Note_Category_2, Thesis_Note_XRef.PID_Note_Category_3, Thesis_Note_XRef.PID_Note_Level, Thesis_Note_XRef.PID_Note_Caption;"
0146 OK = Update_Thesis_Chapter_RLs(Note_ID)
0147 strElement = ""
0148 Case 11
0149 strQuery = "PID_Notes_Unused_By_Thesis_Note_Lists"
0150 strElement = ""
0151 Case 12
0152 strQuery = "PDF_File_List"
0153 strElement = ""
0154 Case 13
0155 strQuery = "Thesis_Reading_List"
0156 strElement = ""
0157 Case 14
0158 Select Case str_Parameter_2_Local
0159 Case "1"
0160 strQuery = "SELECT * FROM Thesis_Reading_List_Cited;"
0161 Case "2"
0162 strQuery = "SELECT * FROM Thesis_Reading_List_Cited_Note WHERE Note_ID = " & Note_ID & " ORDER BY Author, Title;"
0163 End Select
0164 strElement = ""
0165 Case 15
0166 strQuery = "Aeon_Papers_Task_List"
0167 strElement = ""
0168 Case 16
0169 strQuery = "qryTopTen"
0170 strElement = ""
0171 Case 17
0172 strQuery = "qryDailyTasks"
0173 strElement = ""
0174 Case 18
0175 Select Case str_Parameter_2_Local
0176 Case 1
0177 strQuery = "BBC_2025_WebRefs"
0178 Case 2
0179 strQuery = "RIP_WebRefs"
0180 Case 3
0181 strQuery = "qryThesisTasks"
0182 End Select
0183 strElement = ""
0184 Chapter_FieldName = "ZZZZ"
0185End Select
0186Set rs = CurrentDb.OpenRecordset(strQuery)
0187strList_Local = ""
0188If rs.EOF Then
0189 Set rs = Nothing
0190 Debug.Print Now(); "- Functor_22: Option " & strParameter & " (Note = " & Note_ID & ") - No list to print"
0191 If strParameter = 6 Or strParameter = 7 Then
0192 strElement = "|ii|"
0193 strElement = strElement & "|1|No items to list. "
0194 strElement = strElement & "|ii|"
0195 Functor_22 = "Yes"
0196 strList = strElement
0197 Else
0198 If ((strParameter = 8 Or strParameter = 9) And str_Parameter_3_Local = "2") Or (strParameter = 14 And str_Parameter_2_Local = "2") Then
0199 Functor_22 = "Yes"
0200 strElement = strElement & "No items to list. "
0201 strList_Local = strList_Local & strElement
0202 strList = strList_Local
0203 Else
0204 Functor_22 = "No"
0205 End If
0206 End If
0207 Exit Function
0208Else
0209 rs.MoveFirst
0210 iCols = rs.Fields.Count
0211End If
0212'Set up List Header
0213Select Case strParameter
0214 Case 6, 7, 16, 17
0215 strElement = strElement & "|ii|"
0216 Case 10
0217 strElement = "|II|"
0218 Field_3 = ""
0219 Field_4 = ""
0220 Case 3, 5, 8, 9, 11, 12
0221 strElement = "|##|"
0222 Case 18
0223 strElement = "|..|"
0224 Case Else
0225 strElement = strElement & "|99|"
0226End Select
0227strList_Local = strList_Local & strElement
0228strElement = ""
0229Do Until rs.EOF
0230 Field_2 = ""
0231 Select Case strParameter
0232 Case 5, 11
0233 strElement = strElement & "|.|"
0234 strElement = strElement & rs.Fields(0)
0235 Case 6, 7, 13, 14
0236 strElement = strElement & "|1|"
0237 BP = Left(rs.Fields(0), 1)
0238 strElement = strElement & "+" & BP & rs.Fields(1) & BP & "+"
0239 Item_Year = rs.Fields(5) & ""
0240 If Item_Year <> "" Then
0241 strElement = strElement & ", " & Item_Year
0242 End If
0243 If BP = "B" Then
0244 strElement = strElement & ", " & "Book"
0245 End If
0246 Write_Up_Note = rs.Fields(6)
0247 If Write_Up_Note > 0 Then
0248 strElement = strElement & ", [Write-Up Note]++" & Write_Up_Note & "++"
0249 End If
0250 If rs.Fields(7) = True Then
0251 strElement = strElement & ", Annotations"
0252 End If
0253 If rs.Fields(8) = True And Write_Up_Note = 0 Then
0254 strElement = strElement & ", No Abstract"
0255 End If
0256 If rs.Fields(9) = True Then
0257 strElement = strElement & ", External Link"
0258 End If
0259 If rs.Fields(10) = True Then
0260 strElement = strElement & ", Internal PDF Link"
0261 End If
0262 If strParameter = 7 And rs.Fields(11) > 0 Then
0263 strElement = strElement & ", Read = " & rs.Fields(11) & "%"
0264 End If
0265 If strParameter = 13 Or strParameter = 14 Then
0266 If rs.Fields(12) = True Then
0267 strElement = strElement & ", Read"
0268 Else
0269 If rs.Fields(11) > 0 Then
0270 strElement = strElement & ", Read = " & rs.Fields(11) & "%"
0271 End If
0272 End If
0273 End If
0274 FN = rs.Fields(2) & ""
0275 If FN <> "" Then
0276 If (Len(FN) < 31) And InStr(FN, "|") = 0 And InStr(FN, "+") = 0 Then 'Allow for quick comment / characterisation, eg. "Aeon" or "August 2019"
0277 strElement = strElement & ", Note: " & FN
0278 Else
0279 If InStr(FN, "|") = 0 Then
0280 FN = "|..||.|" & FN & "|..|"
0281 End If
0282 strElement = strElement & ", Footnote++FN" & FN & "++"
0283 End If
0284 End If
0285 If str_Parameter_3_Local = "2" Then
0286 If rs.Fields(12) & "" <> "" Then
0287 strElement = strElement & ", Missed Cut: " & rs.Fields(12)
0288 End If
0289 End If
0290 Case 8, 9
0291 strElement = strElement & "|.|"
0292 strElement = strElement & "<b>" & IIf(rs.Fields(0) & "" = "", "General", rs.Fields(0)) & "</b>: "
0293 OK = Functor_22(IIf(strParameter = 8, 6, 7), strCell, Note_ID, str_Parameter_2_Local & rs.Fields(0), str_Parameter_3_Local, str_Parameter_4_Local)
0294 strElement = strElement & strCell
0295 Case 10
0296 If rs.Fields(3) & "" <> Field_4 Then
0297 If Field_4 <> "" Then
0298 Field_2 = Field_2 & "|oo|"
0299 End If
0300 If rs.Fields(3) & "" <> "" Then
0301 Field_2 = Field_2 & "|1|" & rs.Fields(3)
0302 End If
0303 Field_4 = rs.Fields(3) & ""
0304 If Field_4 <> "" Then
0305 Field_2 = Field_2 & "|oo|"
0306 End If
0307 End If
0308 If rs.Fields(2) & "" <> Field_3 Then
0309 If Field_3 <> "" Then
0310 Field_2 = Field_2 & "|AA|"
0311 End If
0312 If rs.Fields(2) & "" <> "" Then
0313 Field_2 = Field_2 & "|1|" & rs.Fields(2) & "|AA|"
0314 End If
0315 Field_3 = rs.Fields(2) & ""
0316 End If
0317 Field_1 = rs.Fields(5)
0318 Select Case Field_1
0319 Case "1"
0320 Field_2 = Field_2 & "|1|"
0321 Case "2"
0322 Field_2 = Field_2 & "|1|"
0323 Case "3"
0324 Field_2 = Field_2 & "|.|"
0325 End Select
0326 Field_2 = Field_2 & "<b>[" & rs.Fields(7) & "]++" & rs.Fields(6) & "++</b>"
0327 strElement = strElement & Field_2
0328 OK = Functor_22(rs.Fields(8), strCell, rs.Fields(6), rs.Fields(9) & "", "De-Duplicate", rs.Fields(0))
0329 strElement = strElement & strCell
0330 Case 12
0331 strElement = strElement & Chr$(10)
0332 strElement = strElement & "|.|" & "<a name=""Off-Page_Link_" & rs.Fields(1) & """></a>" & "<a href = ""../../PDFs/" & rs.Fields(1) & ".pdf"">" & rs.Fields(1) & ".pdf</a> " & rs.Fields(0)
0333 Case 15, 16, 17
0334 strElement = strElement & "|1|"
0335 strElement = strElement & rs.Fields(0)
0336 Case 18
0337 If rs.Fields(2) & "" <> Chapter_FieldName Then
0338 If Chapter_FieldName <> "ZZZZ" Then
0339 If str_Parameter_2_Local = 3 Then
0340 strElement = strElement & "|##|"
0341 Else
0342 strElement = strElement & "|99|"
0343 End If
0344 End If
0345 Chapter_FieldName = rs.Fields(2) & ""
0346 strElement = strElement & "|.|<b>" & Chapter_FieldName & "</b>"
0347 If str_Parameter_2_Local = 3 Then
0348 strElement = strElement & "|##|"
0349 Else
0350 strElement = strElement & "|99|"
0351 End If
0352 End If
0353 If str_Parameter_2_Local = 3 Then
0354 strElement = strElement & "|.|"
0355 Else
0356 strElement = strElement & "|1|"
0357 End If
0358 strElement = strElement & rs.Fields(0)
0359 If iCols > 3 Then
0360 If rs.Fields(3) & "" <> "" Then
0361 strElement = strElement & rs.Fields(3)
0362 End If
0363 End If
0364 Case Else
0365 strElement = strElement & "|.|"
0366 strElement = strElement & "<b>" & rs.Fields(2) & "</b>: "
0367 strCell = rs.Fields(1)
0368 OK = Number_Format(strCell)
0369 strElement = strElement & strCell
0370 End Select
0371 rs.MoveNext
0372Loop
0373strList_Local = strList_Local & strElement
0374'Set up End List ... this should probably be the same as the 'Start List', but isn't!
0375Select Case strParameter
0376 Case 6, 7, 16, 17
0377 strElement = "|ii|"
0378 Case 10
0379 strElement = ""
0380 If Field_4 <> "" Then
0381 strElement = strElement & "|oo|"
0382 End If
0383 If Field_3 <> "" Then
0384 strElement = strElement & "|AA|"
0385 End If
0386 strElement = strElement & "|II|"
0387 Case 13, 14, 15
0388 strElement = "|99|"
0389 Case 18
0390 If str_Parameter_2_Local = 3 Then
0391 strElement = "|##|"
0392 Else
0393 strElement = "|99|"
0394 End If
0395 strElement = strElement & "|..|"
0396 Case Else
0397 strElement = "|##|"
0398End Select
0399strList_Local = strList_Local & strElement
0400Functor_22 = "Yes"
0401strList = strList_Local
0402Set rs = Nothing
0403End Function

Procedures Calling This Procedure (Functor_22) Procedures Called By This Procedure (Functor_22) Tables / Queries / Fragments Directly Used By This Procedure (Functor_22) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: Functor_23
Procedure Type: Public Function
Module: Functors
Lines of Code: 309
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Functor_23(Note_ID, strOption, strValue, Optional str_Parameter_2)
0002'For this function:-
0003' ... Options 1-14 & 21-24 return a value (together with surrounding narrative) from a query
0004' ... Options 15-19 produce an indented list from a query
0005' ... Option 20 produces the table for the Thesis Dashboard
0006Dim rs As Recordset
0007Dim strValue_Local As String
0008Dim strElement As String
0009Dim strMsg As String
0010Dim strQuery As String
0011Dim Field_1 As String
0012Dim Field_2 As String
0013Dim Field_3 As String
0014Dim i As Integer
0015Dim j As Integer
0016Dim str_Parameter_2_Local As String
0017Dim strPara2 As String
0018Dim Note_Parameter As Integer
0019If IsMissing(str_Parameter_2) Then
0020 str_Parameter_2_Local = ""
0021Else
0022 str_Parameter_2_Local = str_Parameter_2
0023End If
0024Select Case strOption
0025 Case "1"
0026 strQuery = "Dud_Cross_References_This_Year"
0027 Case "2"
0028 strQuery = "Cross_Reference_MaxID"
0029 Case "3"
0030 strQuery = "SELECT Count(Cross_Reference_Changes.ID) AS CountOfID FROM Cross_Reference_Changes;"
0031 Case "4"
0032 strQuery = "SELECT Website_Regen_Control.Regen_Mins, Website_Regen_Control.Last_Run, Website_Regen_Control.Division FROM Website_Regen_Control WHERE (((Website_Regen_Control.Division)=""Paper_Abstract_Ranges""));"
0033 Case "5"
0034 strQuery = "SELECT Website_Regen_Control.Regen_Mins, Website_Regen_Control.Last_Run, Website_Regen_Control.Division FROM Website_Regen_Control WHERE (((Website_Regen_Control.Division)=""Author_Letters""));"
0035 Case "6"
0036 strQuery = "SELECT Website_Regen_Control.Regen_Mins, Website_Regen_Control.Last_Run, Website_Regen_Control.Division FROM Website_Regen_Control WHERE (((Website_Regen_Control.Division)=""BookPaperAbstract_Ranges""));"
0037 Case "7"
0038 strQuery = "SELECT Website_Regen_Control.Regen_Mins, Website_Regen_Control.Last_Run, Website_Regen_Control.Division FROM Website_Regen_Control WHERE (((Website_Regen_Control.Division)=""Note_Regen_Ranges""));"
0039 Case "8"
0040 strQuery = "SELECT Website_Regen_Control.Regen_Mins, Website_Regen_Control.Last_Run, Website_Regen_Control.Division FROM Website_Regen_Control WHERE (((Website_Regen_Control.Division)=""Note_Archive_Regen_Ranges""));"
0041 Case "9"
0042 strQuery = "SELECT * FROM Oboe_Latest_Lesson;"
0043 Case "10"
0044 strQuery = "SELECT BookPaperControl.Time_To_Regenerate, BookPaperControl.Latest_Update FROM BookPaperControl WHERE (((BookPaperControl.[ID])=""Auto_Reference_Notes_Regen""));"
0045 Case "11"
0046 strQuery = "Hits_Pages_Totals"
0047 Case "12"
0048 strQuery = "Hits_Pages_Totals_LastYear"
0049 Case "13"
0050 strQuery = "SELECT Count(Site_Map.Size) AS Records, Max([Timestamp_Logged]) AS [As At] FROM Site_Map;"
0051 Case "14"
0052 strQuery = "SELECT Website_Regen_Control.Regen_Mins, Website_Regen_Control.Last_Run, Website_Regen_Control.Division FROM Website_Regen_Control WHERE (((Website_Regen_Control.Division)=""Book_Summary_Ranges""));"
0053 Case "15"
0054 Select Case str_Parameter_2_Local
0055 Case "1"
0056 strQuery = "Earliest_Lang_Dates"
0057 Case "2"
0058 strQuery = "Ling_Progress"
0059 End Select
0060 Case "16", "18"
0061 If str_Parameter_2_Local = "" Then
0062 Note_Parameter = Note_ID
0063 Else
0064 Note_Parameter = str_Parameter_2_Local
0065 End If
0066 strQuery = "SELECT Thesis_Note_XRef.Thesis_Chapter_Note_ID, Thesis_Note_XRef.PID_Note_Seq, Thesis_Note_XRef.PID_Note_Category_1, Thesis_Note_XRef.PID_Note_Category_2, Thesis_Note_XRef.PID_Note_Category_3, Thesis_Note_XRef.PID_Note_Level, Notes.Item_Title, Thesis_Note_XRef.PID_Note_ID, Thesis_Note_XRef.PID_Note_Caption, Thesis_Note_XRef.PID_Footnote, Thesis_Note_XRef.[Exclude?], Thesis_Note_XRef.Reason_Excluded FROM Thesis_Note_XRef INNER JOIN Notes ON Thesis_Note_XRef.PID_Note_ID = Notes.ID WHERE (((Thesis_Note_XRef.Thesis_Chapter_Note_ID) = " & Note_Parameter & ")) ORDER BY Thesis_Note_XRef.PID_Note_Seq, Thesis_Note_XRef.PID_Note_Category_1, Thesis_Note_XRef.PID_Note_Category_2, Thesis_Note_XRef.PID_Note_Category_3, Thesis_Note_XRef.PID_Note_Level, Notes.Item_Title;"
0067 Case "17", "19"
0068 If str_Parameter_2_Local = "Read" Then
0069 strPara2 = "((Functor_Usage.Functor_Option)=6 Or (Functor_Usage.Functor_Option)=8) "
0070 Else
0071 strPara2 = "((Functor_Usage.Functor_Option)=7 Or (Functor_Usage.Functor_Option)=9) "
0072 End If
0073 strQuery = "SELECT Thesis_Note_XRef.Thesis_Chapter_Note_ID, Thesis_Note_XRef.PID_Note_Seq, Thesis_Note_XRef.PID_Note_Category_1, Thesis_Note_XRef.PID_Note_Category_2, Thesis_Note_XRef.PID_Note_Category_3, Thesis_Note_XRef.PID_Note_Level, Notes.Item_Title, Thesis_Note_XRef.PID_Note_ID, Thesis_Note_XRef.PID_Note_Caption, Functor_Usage.Functor_Option, Functor_Usage.Functor_Parameter FROM (Thesis_Note_XRef INNER JOIN Functor_Usage ON Thesis_Note_XRef.PID_Note_ID = Functor_Usage.Note_ID) INNER JOIN Notes ON Thesis_Note_XRef.PID_Note_ID = Notes.ID WHERE (" & strPara2 & " And ((Thesis_Note_XRef.Thesis_Chapter_Note_ID) = " & Note_ID & ") And ((Functor_Usage.Functor_ID) = 22) And ((Thesis_Note_XRef.[Exclude?]) = No)) ORDER BY Thesis_Note_XRef.PID_Note_Seq, Thesis_Note_XRef.PID_Note_Category_1, Thesis_Note_XRef.PID_Note_Category_2, Thesis_Note_XRef.PID_Note_Category_3, Thesis_Note_XRef.PID_Note_Level, Thesis_Note_XRef.PID_Note_Caption;"
0074 Case "20"
0075 strQuery = "Thesis_Progress_Dashboard_List"
0076 Case "21"
0077 Select Case str_Parameter_2_Local
0078 Case "1"
0079 strQuery = "PID_Notes_Unused_By_Thesis_Count"
0080 Case "2"
0081 strQuery = "PID_Notes_Unused_By_Thesis_Note_Lists_Count"
0082 Case "3"
0083 strQuery = "IdentityBooks_Unreferenced_Count"
0084 Case "4"
0085 strQuery = "IdentityPapersRead_Unreferenced_Count"
0086 Case "5"
0087 strQuery = "Works_Missing_By_Thesis_Chapter_Count"
0088 Case "6"
0089 strQuery = "PID_Papers_Filed_Not_Referenced_Count"
0090 Case "7"
0091 strQuery = "PID_Papers_Referenced_Undated_Count"
0092 Case "8"
0093 strQuery = "PID_Papers_Referenced_No_Abstract_Count"
0094 Case "9"
0095 strQuery = "Large_Page_List_Count"
0096 Case "10"
0097 strQuery = "PDF_Missing_List_Count"
0098 Case "11"
0099 strQuery = "Duplicate_Papers_Count"
0100 Case "12"
0101 strQuery = "PDF_File_List_Count"
0102 Case "13"
0103 strQuery = "Missing_Webref_DisplayText_List_Count"
0104 Case "14"
0105 strQuery = "PID_Missing_Online_Papers_List_Count"
0106 Case "15"
0107 strQuery = "Missing_Webref_DisplayText_List_Books_Count"
0108 Case "16"
0109 strQuery = "Papers_Inconsistently_Electronic_Count"
0110 Case "17"
0111 strQuery = "Thesis_Reading_List_Count"
0112 Case "18"
0113 strQuery = "Thesis_Reading_List_Cited_Count"
0114 End Select
0115 Case "22"
0116 strQuery = "SELECT PID_Missing_Online_Papers_List.[PID Note], Sum(1) AS Total, Sum(IIf([Accept?]=""Yes"",1,0)) AS Accepted, Sum(IIf([Pending?]=""Yes"",1,0)) AS Pending, Sum(IIf([Reserve?]=""Yes"",1,0)) AS Reserve FROM PID_Missing_Online_Papers_List WHERE (((PID_Missing_Online_Papers_List.[PID Note]) Like ""*+" & Note_ID & "+*"")) GROUP BY PID_Missing_Online_Papers_List.[PID Note];"
0117 Case "23"
0118 Select Case str_Parameter_2_Local
0119 Case "1"
0120 strQuery = "PID_Pages_Total"
0121 Case "2"
0122 strQuery = "Paper_Pages_Total"
0123 End Select
0124 Case "24"
0125 strQuery = "Aeon_Papers_Task_List_Count"
0126 Case "25"
0127 strQuery = "qryDailyTasksTotal"
0128 Case Else
0129 Debug.Print Now(); "- Note: " & Note_ID & ". Functor_23 : Invalid Option : " & strOption
0130 Functor_23 = "No"
0131 Exit Function
0132End Select
0133If strOption <> "20" Then
0134 Set rs = CurrentDb.OpenRecordset(strQuery)
0135 strValue_Local = ""
0136 If rs.EOF Then
0137 Debug.Print Now(); "- Note: " & Note_ID & ". Functor_23 : No item to print (Option = " & strOption & ")"
0138 Functor_23 = "No"
0139 Exit Function
0140 End If
0141End If
0142Select Case strOption
0143 Case "1"
0144 rs.MoveLast
0145 strElement = rs.Fields(1)
0146 If rs.Fields(0) <> rs.Fields(2) Then
0147 strElement = 0
0148 End If
0149 If strElement = 0 Then
0150 strElement = "no"
0151 strMsg = "encouraging."
0152 Else
0153 strMsg = "<b>worrying. <u>Investigate</u>!</b>"
0154 Debug.Print Now(); "Note: " & Note_ID & ". Functor_23, Option 1 : Non-zero value printed - Investigate!"
0155 End If
0156 strValue_Local = strElement & " record" & IIf(Val(strElement) > 1, "s", "") & " for " & rs.Fields(2) & " prior to the " & rs.Fields(3) & " regeneration, which is " & strMsg
0157 Case "2"
0158 rs.MoveFirst
0159 strElement = rs.Fields(0)
0160 OK = Number_Format(strElement)
0161 strValue_Local = Now() & " it is " & strElement & " - but it's taken " & Year(Now) - 2015
0162 Case "3"
0163 rs.MoveFirst
0164 strElement = rs.Fields(0)
0165 OK = Number_Format(strElement)
0166 strValue_Local = strElement & " rows, as of " & Left(Now(), 10) & ", "
0167 Case "4", "5", "6", "7", "8", "10", "14"
0168 rs.MoveFirst
0169 strElement = rs.Fields(0)
0170 If strElement >= 60 Then
0171 strElement = Round(strElement / 60, 2) & " hours"
0172 Else
0173 strElement = strElement & " minutes"
0174 End If
0175 strElement = strElement & " on " & Left(rs.Fields(1), 10)
0176 strValue_Local = strElement
0177 Case "9", "24"
0178 rs.MoveFirst
0179 strValue_Local = rs.Fields(0) & ""
0180 Case "11", "12"
0181 rs.MoveFirst
0182 Field_1 = Nz(rs.Fields(0), 0) 'Min period recorded
0183 Field_2 = Nz(rs.Fields(1), 0) 'Max period recorded
0184 Field_3 = Nz(rs.Fields(2), 0) 'Total Hits
0185 Field_1 = Left(Field_1, 4) * 12 + Right(Field_1, 2)
0186 Field_2 = Left(Field_2, 4) * 12 + Right(Field_2, 2)
0187 Field_1 = Field_2 - Field_1 + 1
0188 Field_2 = Field_1 * 365 / 12
0189 Field_3 = Round(Field_3 / Field_2 / 1000, 1)
0190 strValue_Local = Field_3 & "k or so hits a day over the " & Field_1 & " months up to " & rs.Fields(1)
0191 Case "13"
0192 rs.MoveFirst
0193 strValue_Local = Round(rs.Fields(0) / 1000, 0) & "k pages on my site as at " & Left(rs.Fields(1), 10)
0194 Case "15"
0195 rs.MoveFirst
0196 Select Case str_Parameter_2_Local
0197 Case "1"
0198 strValue_Local = "The next languages in the queue are:- |..|"
0199 Field_3 = ""
0200 Case "2"
0201 strValue_Local = "Progress on Ling (in progress order):- |..|"
0202 Field_2 = ""
0203 End Select
0204 Do Until rs.EOF
0205 Select Case str_Parameter_2_Local
0206 Case "1"
0207 Field_1 = rs.Fields(0) & rs.Fields(1)
0208 Field_2 = rs.Fields(2)
0209 If Field_2 = "0" Then
0210 Field_2 = "Not yet studied"
0211 Else
0212 Field_2 = "Last studied on " & Format(Field_2, "Long Date")
0213 If rs.Fields(4) & "" > "0" Then
0214 Field_2 = Field_2 & "; Last Ling Lesson = " & rs.Fields(4)
0215 End If
0216 If rs.Fields(5) & "" <> "" Then
0217 Field_2 = Field_2 & "; Last Ling Revision = " & rs.Fields(5)
0218 End If
0219 End If
0220 If Field_3 <> Field_1 Then
0221 If Field_3 <> "" Then
0222 strValue_Local = strValue_Local & "|99|"
0223 End If
0224 strValue_Local = strValue_Local & "|.|<b>" & rs.Fields(0) & ": Priority " & rs.Fields(1) & "</b>: |99|"
0225 End If
0226 strValue_Local = strValue_Local & "|1|<b>" & Replace(rs.Fields(3), " (Modern)", "") & "</b>. " & Field_2
0227 Field_3 = Field_1
0228 Case "2"
0229 Field_1 = rs.Fields(0)
0230 If Field_2 <> Field_1 Then
0231 If Field_2 <> "" Then
0232 strValue_Local = strValue_Local & "|99|"
0233 End If
0234 strValue_Local = strValue_Local & "|.|<b>Priority " & Field_1 & "</b>:- |99|"
0235 End If
0236 strValue_Local = strValue_Local & "|1|<b>" & rs.Fields(2) & "</b>: " & rs.Fields(1) & IIf(rs.Fields(3) & "" <> "", " (Revision: " & rs.Fields(3) & ")", "")
0237 Field_2 = Field_1
0238 End Select
0239 rs.MoveNext
0240 Loop
0241 strValue_Local = strValue_Local & "|99||..|"
0242 Case "16"
0243 OK = Functor_Indented_List(rs, strValue_Local)
0244 Case "17"
0245 OK = Update_Thesis_Chapter_RLs(Note_ID)
0246 OK = Functor_Indented_List(rs, strValue_Local, True)
0247 Case "18" 'Test only
0248 OK = Functor_Indented_List_Development(rs, strValue_Local)
0249 Case "19"
0250 OK = Update_Thesis_Chapter_RLs(Note_ID)
0251 OK = Functor_Indented_List_Development(rs, strValue_Local, True)
0252 Case "20"
0253 OK = Thesis_Dashboard_Table_Gen(strValue_Local, strQuery)
0254 Case "21"
0255 rs.MoveFirst
0256 strElement = rs.Fields(0)
0257 If str_Parameter_2_Local = "6" Then
0258 Field_1 = Nz(rs.Fields(1))
0259 End If
0260 OK = Number_Format(strElement)
0261 strValue_Local = "(" & strElement & " item" & IIf(strElement = 1, "", "s") & IIf(str_Parameter_2_Local = "6", ", " & Field_1 & " unactioned", "") & ")"
0262 If str_Parameter_2_Local = "17" Or str_Parameter_2_Local = "18" Then
0263 strValue_Local = Replace(strValue_Local, "(", "")
0264 strValue_Local = Replace(strValue_Local, ")", "")
0265 End If
0266 Case "22"
0267 If rs.EOF Then
0268 strValue_Local = ""
0269 Else
0270 strValue_Local = "|.|"
0271 Field_1 = rs.Fields(0)
0272 Field_1 = Mid(Field_1, 2, InStr(Field_1, "]") - 2)
0273 Field_1 = Replace(Field_1, " ", "")
0274 'Field_1 = "PDFs_" & Field_1
0275 Field_1 = Left("PDFs_" & Field_1, 20)
0276 Field_1 = "For further papers held on-line of potential interest, follow this Link++1317#" & Field_1 & "++."
0277 i = rs.Fields.Count
0278 Field_1 = Field_1 & " Total papers = " & rs.Fields(1)
0279 If i > 2 Then
0280 Field_1 = Field_1
0281 Field_3 = ". Including "
0282 j = 2
0283 Field_2 = ""
0284 Do Until j > i - 1
0285 If rs.Fields(j) > 0 Then
0286 Field_1 = Field_1 & Field_3 & Field_2 & rs.Fields(j).Name & " = " & rs.Fields(j)
0287 Field_2 = ", "
0288 Field_3 = ""
0289 End If
0290 j = j + 1
0291 Loop
0292 Field_1 = Field_1 & "."
0293 End If
0294 strValue_Local = strValue_Local & Field_1
0295 End If
0296 Case "23"
0297 rs.MoveFirst
0298 strElement = rs.Fields(0)
0299 strElement = Round(strElement / 1000, 0)
0300 OK = Number_Format(strElement)
0301 strValue_Local = strElement & "k pages, as at " & Now()
0302 Case "25"
0303 rs.MoveFirst
0304 strValue_Local = Round(rs.Fields(0) / 60, 2) & " hours"
0305End Select
0306Functor_23 = "Yes"
0307strValue = Trim(strValue_Local)
0308Set rs = Nothing
0309End Function

Procedures Calling This Procedure (Functor_23) Procedures Called By This Procedure (Functor_23) Tables / Queries / Fragments Directly Used By This Procedure (Functor_23) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: Jacks_Non_Prime
Procedure Type: Public Sub
Module: Testing
Lines of Code: 36
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Jacks_Non_Prime()
0002'Prove that 2^10 + 5^12 is non-prime
0003'The program shows:-
0004'... The number is 244,141,649 = 14657 x 16657
0005'... Max Long is 2,147,483,647, so didn't need LongLong
0006Dim Non_Prime As LongLong
0007Dim Non_Prime_Temp As LongLong
0008Dim Non_Prime_Sqrt As Integer
0009Dim i As Integer
0010Non_Prime_Temp = 1
0011For i = 1 To 10
0012 Non_Prime_Temp = Non_Prime_Temp * 2
0013Next i
0014Debug.Print Non_Prime_Temp
0015Non_Prime = Non_Prime_Temp
0016Non_Prime_Temp = 1
0017For i = 1 To 12
0018 Non_Prime_Temp = Non_Prime_Temp * 5
0019Next i
0020Debug.Print Non_Prime_Temp
0021Non_Prime = Non_Prime + Non_Prime_Temp
0022Debug.Print Non_Prime
0023Non_Prime_Sqrt = Non_Prime ^ 0.5
0024Debug.Print Non_Prime_Sqrt
0025Non_Prime_Sqrt = Non_Prime_Sqrt / 2 + 1
0026For i = 1 To Non_Prime_Sqrt
0027 Non_Prime_Temp = Non_Prime Mod (2 * i + 1)
0028 If Non_Prime_Temp = 0 Then
0029 Debug.Print 2 * i + 1
0030 Non_Prime_Temp = Non_Prime / (2 * i + 1)
0031 Debug.Print Non_Prime_Temp
0032 Non_Prime_Temp = Non_Prime_Temp * (2 * i + 1)
0033 Debug.Print Non_Prime_Temp
0034 End If
0035Next i
0036End Sub

Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: Number_Format
Procedure Type: Public Function
Module: New Code
Lines of Code: 42
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Number_Format(strNumber_Sent)
0002Dim strNumber_Local As String
0003Dim Digit_Table(20) As String
0004Dim i As Integer
0005Dim j As Integer
0006Dim iLen_Number As Integer
0007'This function inserts commas into a number sent ...
0008'I may get it to do further functions in due course
0009' .... I couldn't find an HTML format command to do this
0010' .... but there must be a VBA built-in function?
0011strNumber_Local = Trim(strNumber_Sent)
0012If Not IsNumeric(strNumber_Local) Then
0013 Exit Function
0014End If
0015If Val(strNumber_Local) < 1000 Then 'Can't be any commas
0016 Exit Function
0017End If
0018iLen_Number = Len(strNumber_Local)
0019For i = 1 To 20
0020 Digit_Table(i) = ""
0021Next i
0022'Add the commas (in reverse)
0023j = 1
0024For i = 1 To iLen_Number
0025 Digit_Table(j) = Mid(strNumber_Local, iLen_Number + 1 - i, 1)
0026 j = j + 1
0027 If i Mod 3 = 0 Then
0028 Digit_Table(j) = ","
0029 j = j + 1
0030 End If
0031Next i
0032'Remove trailing comma
0033If Digit_Table(j - 1) = "," Then
0034 Digit_Table(j - 1) = ""
0035End If
0036strNumber_Local = ""
0037For i = 1 To j - 1
0038 strNumber_Local = strNumber_Local & Digit_Table(j - i)
0039Next i
0040'Exit
0041strNumber_Sent = strNumber_Local
0042End Function

Procedures Calling This Procedure (Number_Format) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


© Theo Todman, June 2007 - Jan 2026. Please address any comments on this page to theo@theotodman.com. File output:
Website Maintenance Dashboard
Return to Top of this Page Return to Theo Todman's Philosophy Page Return to Theo Todman's Home Page