Line-No. / Ref. | Code Line |
0001 | Public Function ImageRef(strLineIn, Caller, Calling_Type, Calling_ID, Calling_Timestamp, Optional iDepth) |
0002 | Dim z As Long |
0003 | Dim Y As Long |
0004 | Dim y1 As Long |
0005 | Dim y2 As Long |
0006 | Dim yy As Long |
0007 | Dim strLine As String |
0008 | Dim strImageRef As String |
0009 | Dim strPrefix As String |
0010 | Dim Image_Found As Boolean |
0011 | Dim Image_Ref_Kernel As String |
0012 | Dim Image_ID As Long |
0013 | strLine = strLineIn & "" |
0014 | Image_Found = False |
0015 | z = 1 |
0016 | Select Case Caller |
0017 | Case "Notes", "NoteFootnotes", "Abstract" |
0018 | strPrefix = "../../Photos/Notes/" |
0019 | Case "NotesPrint" |
0020 | strPrefix = "../../../Photos/Notes/" |
0021 | Case "NotesConcatenated" |
0022 | strPrefix = "../Photos/Notes/" |
0023 | Case Else |
0024 | z = 0 |
0025 | End Select |
0026 | If Not IsMissing(iDepth) Then |
0027 | Select Case iDepth |
0028 | Case 1 |
0029 | strPrefix = Mid(strPrefix, 4, Len(strPrefix)) |
0030 | Case 0, 2 |
0031 | Case 3 |
0032 | strPrefix = "../" & strPrefix |
0033 | Case Else |
0034 | End Select |
0035 | End If |
0036 | Do While z > 0 |
0037 | 'Find the next Weblink-start |
0038 | Y = InStr(z, strLine, "SRC") |
0039 | If Y > 0 Then |
0040 | yy = InStr(Y, strLine, "=") |
0041 | If yy > 0 Then |
0042 | If Trim(Mid(strLine, Y + 3, yy - Y - 2)) = "=" Then |
0043 | Y = InStr(Y, strLine, """") |
0044 | If Y > 0 Then |
0045 | If Y = yy + 1 Or Trim(Mid(strLine, yy + 1, Y - yy - 1)) & "" = "" Then |
0046 | yy = InStr(Y + 1, strLine, """") |
0047 | If yy > 0 Then |
0048 | Image_Found = True |
0049 | strImageRef = Trim(Mid(strLine, Y + 1, yy - Y - 1)) |
0050 | strImageRef = Replace(strImageRef, "../", "") |
0051 | Image_ID = Images_Add(TheoWebsiteRoot & "\Photos\Notes\", strImageRef, True, False) |
0052 | strImageRef = strPrefix & strImageRef |
0053 | If Calling_Type <> "X" Then |
0054 | OK = Cross_Reference_Add(Calling_Type, Calling_ID, Calling_Timestamp, "I", Image_ID, 0) |
0055 | End If |
0056 | strLine = Left(strLine, Y) & strImageRef & Mid(strLine, yy, Len(strLine)) |
0057 | z = Y + Len(strImageRef) |
0058 | Else |
0059 | z = 0 |
0060 | End If |
0061 | Else |
0062 | z = 0 |
0063 | End If |
0064 | Else |
0065 | z = 0 |
0066 | End If |
0067 | Else |
0068 | z = 0 |
0069 | End If |
0070 | Else |
0071 | z = 0 |
0072 | End If |
0073 | Else |
0074 | z = 0 |
0075 | End If |
0076 | Loop |
0077 | z = 1 |
0078 | Do While z > 0 |
0079 | 'Find the next .gif, or .jpg |
0080 | y1 = InStr(z, strLine, ".gif") |
0081 | If y1 = 0 Then |
0082 | y1 = Len(strLine) |
0083 | End If |
0084 | y2 = InStr(z, strLine, ".jpg") |
0085 | If y2 = 0 Then |
0086 | y2 = Len(strLine) |
0087 | End If |
0088 | If y1 < y2 Then |
0089 | Y = y1 |
0090 | Else |
0091 | Y = y2 |
0092 | End If |
0093 | If Y < Len(strLine) Then |
0094 | yy = Y - 1 |
0095 | Image_Found = False |
0096 | 'Check for “.jpg” or “.gif” etc. used in documentation |
0097 | If Mid(strLine, yy, 1) = "“" Then |
0098 | z = Y + 1 |
0099 | Else |
0100 | Do While yy > 0 And Image_Found = False |
0101 | 'Search for previous " |
0102 | If Mid(strLine, yy, 1) = """" Then |
0103 | Image_Found = True |
0104 | Else |
0105 | yy = yy - 1 |
0106 | End If |
0107 | Loop |
0108 | End If |
0109 | If Image_Found = True Then |
0110 | strImageRef = Trim(Mid(strLine, yy + 1, Y - yy - 1)) |
0111 | strImageRef = Replace(strImageRef, "../", "") |
0112 | 'Need to ignore external links |
0113 | If InStr(strImageRef, "http:") > 0 Or InStr(strImageRef, "www.") > 0 Then |
0114 | Else |
0115 | 'Need to check not SRC, already fixed above ... |
0116 | If Mid(strLine, yy - 4, 3) = "SRC" Then |
0117 | Else |
0118 | Image_Ref_Kernel = strImageRef & Mid(strLine, Y, 5) |
0119 | Image_Ref_Kernel = Replace(Image_Ref_Kernel, """", "") |
0120 | Image_Ref_Kernel = Trim(Image_Ref_Kernel) |
0121 | 'Check for duds |
0122 | If Len(Image_Ref_Kernel) > 100 Then |
0123 | Stop |
0124 | End If |
0125 | Image_ID = Images_Add(TheoWebsiteRoot & "\Photos\Notes\", Image_Ref_Kernel, False, True) |
0126 | strImageRef = strPrefix & strImageRef |
0127 | If Calling_Type <> "X" Then |
0128 | OK = Cross_Reference_Add(Calling_Type, Calling_ID, Calling_Timestamp, "I", Image_ID, 0) |
0129 | End If |
0130 | strLine = Left(strLine, yy) & strImageRef & Mid(strLine, Y, Len(strLine)) |
0131 | End If |
0132 | End If |
0133 | z = Y + Len(strImageRef) |
0134 | Else |
0135 | z = Y + 1 |
0136 | End If |
0137 | Else |
0138 | z = 0 |
0139 | End If |
0140 | Loop |
0141 | TheEnd: |
0142 | ImageRef = strLine |
0143 | End Function |
Line-No. / Ref. | Code Line |
0001 | Public Sub Monthly_Report_Note1005_Update(Timecode) |
0002 | Static strLine_Stored As String |
0003 | Dim rsTableControl As Recordset |
0004 | Dim rsTableControl2 As Recordset |
0005 | Dim strQuery As String |
0006 | Dim i As Long |
0007 | Dim j As Integer |
0008 | Dim ifields As Integer |
0009 | Dim Field_Width As Single |
0010 | Dim Field_Width_Temp As Single |
0011 | Dim iTableWidth As Single |
0012 | Dim iTot(40) As Single |
0013 | Dim iTot2(40) As Single |
0014 | Dim iTotal As Single |
0015 | Dim iTotal2 As Single |
0016 | Dim Alignment As String |
0017 | Dim Field_Temp As String |
0018 | Dim YTD_Fields As Integer |
0019 | Select Case Timecode |
0020 | Case 1 |
0021 | strLine_Stored = "This page shows the following tables (which are unlikely to be of any interest to anyone other than myself). Click on the links, or scroll down:-|99|" |
0022 | strLine_Stored = strLine_Stored & "|1|Time expended on my various projects over " & IIf(Right(iReporting_Year - 2007 + 1, 1) = 8, "an ", "a ") & iReporting_Year - 2007 + 1 & "-year period" |
0023 | strLine_Stored = strLine_Stored & "|1|Time expended on my various projects and the major sub-projects thereof over " & IIf(Right(iReporting_Year - 2007 + 1, 1) = 8, "an ", "a ") & iReporting_Year - 2007 + 1 & "-year period" |
0024 | strLine_Stored = strLine_Stored & "|1|Time expended on my various projects and the sub-projects thereof over " & IIf(Right(iReporting_Year - 2007 + 1, 1) = 8, "an ", "a ") & iReporting_Year - 2007 + 1 & "-year period|99|" |
0025 | 'Add links to other reports ... |
0026 | strLine_Stored = strLine_Stored & "For convenience, here are links to the other reports in this set. Clicking on the link takes you from this page to the relevant report:- " |
0027 | strLine_Stored = strLine_Stored & "|99|" |
0028 | strLine_Stored = strLine_Stored & "|1|[Click Here]++863++ for (by Project)|..||.|Summary of Effort YTD & QTD|.|Time Analysis (YTD by Study-location)|..|" |
0029 | strLine_Stored = strLine_Stored & "|1|[Click Here]++980++ for (by Project) |..||.|Plan versus Actual Effort Summary - Split (Previous Quarter & YTD)|.|Plan versus Actual Effort Summary - Actual (Previous Quarter & YTD)|.|Plan Summary (Next Quarter & Full Year)|.|Actual & Plan Summary (2007 - " & iReporting_Year & ")|..|" |
0030 | strLine_Stored = strLine_Stored & "|99| " |
0031 | strQuery = "Time_By_Month (Grand Summary)" |
0032 | strLine_Stored = strLine_Stored & "ProjectsBelow is a table showing the split of time (in hours) expended between my various projects over " & IIf(Right(iReporting_Year - 2007 + 1, 1) = 8, "an ", "a ") & iReporting_Year - 2007 + 1 & "-year period:- " |
0033 | Case 2 |
0034 | strLine_Stored = strLine_Stored & "
Projects & Major Sub-ProjectsBelow is a table showing the split of time expended (in hours) between my various projects and the major sub-projects thereof over " & IIf(Right(iReporting_Year - 2007 + 1, 1) = 8, "an ", "a ") & iReporting_Year - 2007 + 1 & "-year period:- " |
0035 | strQuery = "Time_By_Month (Summary)" |
0036 | Case 3 |
0037 | strLine_Stored = strLine_Stored & "
Projects & Sub-ProjectsBelow is a table showing the split of time expended (in hours) between my various projects and the sub-projects thereof over " & IIf(Right(iReporting_Year - 2007 + 1, 1) = 8, "an ", "a ") & iReporting_Year - 2007 + 1 & "-year period:- " |
0038 | strQuery = "Time_By_Month" |
0039 | End Select |
0040 | Set rsTableControl2 = CurrentDb.OpenRecordset(strQuery) |
0041 | rsTableControl2.MoveFirst |
0042 | ifields = rsTableControl2.Fields.Count |
0043 | i = iEnd_Reporting_Month |
0044 | If i > 9 Then |
0045 | i = 12 + 9 - i |
0046 | Else |
0047 | i = 9 - i |
0048 | End If |
0049 | ifields = ifields - i |
0050 | YTD_Fields = 12 - i |
0051 | Field_Width = 100 / (ifields + 7) |
0052 | iTableWidth = (ifields + 7) * 90 |
0053 | If Not rsTableControl2.EOF Then |
0054 | rsTableControl2.MoveFirst |
0055 | strLine_Stored = strLine_Stored & ""
0056 | End If |
0057 | 'Header Row |
0058 | strLine_Stored = strLine_Stored & ""
0059 | j = 0 |
0060 | Do While j < ifields |
0061 | Field_Width_Temp = Field_Width |
0062 | Alignment = "Center" |
0063 | Select Case j |
0064 | Case 0 |
0065 | Field_Width_Temp = Field_Width * 4 |
0066 | Alignment = "Left" |
0067 | Field_Temp = rsTableControl2.Fields(j).Name |
0068 | Case Is > 0 |
0069 | Field_Temp = rsTableControl2.Fields(j).Name |
0070 | End Select |
0071 | If Field_Temp <> "Not Required" Then |
0072 | strLine_Stored = strLine_Stored & "" & Field_Temp & " | " |
0073 | End If |
0074 | j = j + 1 |
0075 | Loop |
0076 | 'Repeat the sub-project name at the end column |
0077 | Field_Width_Temp = Field_Width * 4 |
0078 | Alignment = "Left" |
0079 | Field_Temp = rsTableControl2.Fields(0).Name |
0080 | strLine_Stored = strLine_Stored & "" & Field_Temp & " | " |
0081 | strLine_Stored = strLine_Stored & " | " |
0082 | 'Output the rows |
0083 | For j = 0 To 40 |
0084 | iTot(j) = 0 |
0085 | Next j |
0086 | For i = 0 To 40 |
0087 | iTot2(i) = 0 |
0088 | Next i |
0089 | iTotal = 0 |
0090 | iTotal2 = 0 |
0091 | i = 0 |
0092 | rsTableControl2.MoveFirst |
0093 | Do While Not rsTableControl2.EOF |
0094 | i = i + 1 |
0095 | strLine_Stored = strLine_Stored & ""
0096 | iTotal = 0 |
0097 | iTotal2 = 0 |
0098 | For j = ifields - YTD_Fields To ifields - 1 |
0099 | If rsTableControl2.Fields(j) & "" = "" Then |
0100 | Field_Temp = 0 |
0101 | Else |
0102 | Field_Temp = rsTableControl2.Fields(j) |
0103 | End If |
0104 | iTotal = iTotal + Val(Field_Temp) |
0105 | Next j |
0106 | For j = 5 To ifields - 1 |
0107 | If rsTableControl2.Fields(j) & "" = "" Then |
0108 | Field_Temp = 0 |
0109 | Else |
0110 | Field_Temp = rsTableControl2.Fields(j) |
0111 | End If |
0112 | iTotal2 = iTotal2 + Field_Temp |
0113 | Next j |
0114 | j = 0 |
0115 | Do While j < ifields |
0116 | Field_Width_Temp = Field_Width |
0117 | Alignment = "Center" |
0118 | Select Case j |
0119 | Case 0 |
0120 | Field_Width_Temp = Field_Width * 4 |
0121 | Alignment = "Left" |
0122 | Field_Temp = rsTableControl2.Fields(j) |
0123 | Case 1 |
0124 | Field_Temp = iTotal |
0125 | iTot(j) = iTot(j) + Field_Temp |
0126 | Case 2 |
0127 | Field_Temp = iTotal / YTD_Tot_Saved * 100 |
0128 | iTot(j) = iTot(j) + Field_Temp |
0129 | Case 3 |
0130 | Field_Temp = iTotal2 |
0131 | iTot(j) = iTot(j) + Field_Temp |
0132 | Case 4 |
0133 | Field_Temp = iTotal2 / Historic_Total * 100 |
0134 | iTot(j) = iTot(j) + Field_Temp |
0135 | Case Is > 4 |
0136 | If rsTableControl2.Fields(j) & "" = "" Then |
0137 | Field_Temp = 0 |
0138 | Else |
0139 | Field_Temp = rsTableControl2.Fields(j) |
0140 | End If |
0141 | iTot(j) = iTot(j) + Field_Temp |
0142 | iTotal = iTotal + Field_Temp |
0143 | End Select |
0144 | If j > 0 Then |
0145 | If j = 2 Or j = 4 Then |
0146 | If Field_Temp < 0.005 Then |
0147 | Field_Temp = " " |
0148 | Else |
0149 | Field_Temp = Round(Field_Temp, 2) |
0150 | End If |
0151 | Else |
0152 | If Field_Temp < 0.05 Then |
0153 | Field_Temp = " " |
0154 | Else |
0155 | If Field_Temp < 0.05 Then |
0156 | Field_Temp = Round(Field_Temp, 1) |
0157 | Else |
0158 | Field_Temp = Round(Field_Temp, 0) |
0159 | End If |
0160 | End If |
0161 | End If |
0162 | End If |
0163 | If Field_Temp <> "Not Required" Then |
0164 | strLine_Stored = strLine_Stored & "" & Field_Temp & " | " |
0165 | End If |
0166 | j = j + 1 |
0167 | Loop |
0168 | 'Repeat the sub-project name at the end column |
0169 | Field_Width_Temp = Field_Width * 4 |
0170 | Alignment = "Left" |
0171 | Field_Temp = rsTableControl2.Fields(0) |
0172 | strLine_Stored = strLine_Stored & "" & Field_Temp & " | " |
0173 | strLine_Stored = strLine_Stored & " | " |
0174 | rsTableControl2.MoveNext |
0175 | Loop |
0176 | 'Total Row |
0177 | j = 0 |
0178 | iTotal = 0 |
0179 | strLine_Stored = strLine_Stored & ""
0180 | Do While j < ifields |
0181 | Field_Width_Temp = Field_Width |
0182 | Alignment = "Center" |
0183 | Select Case j |
0184 | Case 0 |
0185 | Field_Width_Temp = Field_Width * 4 |
0186 | Alignment = "Left" |
0187 | Field_Temp = "Total" |
0188 | Case Else |
0189 | Field_Temp = iTot(j) |
0190 | End Select |
0191 | If j > 0 Then |
0192 | If Field_Temp < 0.05 Then |
0193 | Field_Temp = " " |
0194 | Else |
0195 | If Field_Temp < 0.05 Then |
0196 | Field_Temp = Round(Field_Temp, 1) |
0197 | Else |
0198 | Field_Temp = Round(Field_Temp, 0) |
0199 | End If |
0200 | End If |
0201 | End If |
0202 | If Field_Temp <> "Not Required" Then |
0203 | strLine_Stored = strLine_Stored & "" & Field_Temp & " | " |
0204 | End If |
0205 | j = j + 1 |
0206 | Loop |
0207 | 'Repeat the sub-project name at the end column |
0208 | Field_Width_Temp = Field_Width * 4 |
0209 | Alignment = "Left" |
0210 | Field_Temp = "Total" |
0211 | strLine_Stored = strLine_Stored & "" & Field_Temp & " | " |
0212 | strLine_Stored = strLine_Stored & " | " |
0213 | If Timecode = 3 Then |
0214 | 'Repeat Header Row as bottom row |
0215 | strLine_Stored = strLine_Stored & ""
0216 | j = 0 |
0217 | Do While j < ifields |
0218 | Field_Width_Temp = Field_Width |
0219 | Alignment = "Center" |
0220 | Select Case j |
0221 | Case 0 |
0222 | Field_Width_Temp = Field_Width * 4 |
0223 | Alignment = "Left" |
0224 | Field_Temp = rsTableControl2.Fields(j).Name |
0225 | Case Is > 0 |
0226 | Field_Temp = rsTableControl2.Fields(j).Name |
0227 | End Select |
0228 | If Field_Temp <> "Not Required" Then |
0229 | strLine_Stored = strLine_Stored & "" & Field_Temp & " | " |
0230 | End If |
0231 | j = j + 1 |
0232 | Loop |
0233 | 'Repeat the sub-project name at the end column |
0234 | Field_Width_Temp = Field_Width * 4 |
0235 | Alignment = "Left" |
0236 | Field_Temp = rsTableControl2.Fields(0).Name |
0237 | strLine_Stored = strLine_Stored & "" & Field_Temp & " | " |
0238 | strLine_Stored = strLine_Stored & " | " |
0239 | End If |
0240 | 'Footer |
0241 | strLine_Stored = strLine_Stored & " | " |
0242 | If Timecode = 3 Then |
0243 | If Nz(StrTitle_Year & Right(iStart_Reporting_Month + 100, 2)) < 1308 Then |
0244 | strLine_Stored = strLine_Stored & "
Previous Version" |
0245 | End If |
0246 | 'Read Note 1005 for update |
0247 | strQuery = "SELECT Notes.* FROM Notes WHERE Notes.ID = 1005;" |
0248 | Set rsTableControl = CurrentDb.OpenRecordset(strQuery) |
0249 | rsTableControl.MoveFirst |
0250 | rsTableControl.Edit |
0251 | 'Update Note 1005 |
0252 | 'Note Text |
0253 | rsTableControl.Fields(3) = strLine_Stored |
0254 | 'Note Title |
0255 | strLine_Stored = "Status: Actual Detail Summary (2007 - " & iReporting_Year + 1 & ")" |
0256 | rsTableControl.Fields(1) = strLine_Stored |
0257 | 'Set Note Status |
0258 | rsTableControl.Fields(10) = "Temp" |
0259 | rsTableControl.Update |
0260 | 'Output the Note regeneration request |
0261 | DoCmd.RunSQL ("DELETE Notes_To_Regen.* FROM Notes_To_Regen;") |
0262 | Set rsTableControl = CurrentDb.OpenRecordset("SELECT Notes_To_Regen.* FROM Notes_To_Regen;") |
0263 | rsTableControl.AddNew |
0264 | rsTableControl.Fields(0) = 1005 |
0265 | rsTableControl.Update |
0266 | Archive_Notes_Now = "No" |
0267 | Regenerate_the_Links = "No" |
0268 | Regen_Notes_Only = "Yes" |
0269 | CreateNotesWebPages |
0270 | End If |
0271 | End Sub |
Line-No. / Ref. | Code Line |
0001 | Public Function Reference_Code_Bridge(strText, Optional Depth) |
0002 | Dim x As Long |
0003 | Dim Y As Long |
0004 | Dim strCodeRef As String |
0005 | Dim CodeRef As String |
0006 | Dim strText_Local As String |
0007 | Dim strText_End As String |
0008 | Dim qryString As String |
0009 | Dim rsTableToRead As Recordset |
0010 | Dim CodeLocation As String |
0011 | Dim iDepth As Integer |
0012 | Dim strPrefix As String |
0013 | Dim i As Integer |
0014 | If Len(strText) = 0 Then |
0015 | Reference_Code_Bridge = "Not Found" |
0016 | Exit Function |
0017 | End If |
0018 | If IsMissing(Depth) Then |
0019 | iDepth = 2 |
0020 | Else |
0021 | iDepth = Depth |
0022 | End If |
0023 | i = 0 |
0024 | strPrefix = "" |
0025 | Do While i < iDepth |
0026 | strPrefix = strPrefix & "../" |
0027 | i = i + 1 |
0028 | Loop |
0029 | strText_Local = strText |
0030 | x = 1 |
0031 | x = InStr(x, strText_Local, "+C") |
0032 | Reference_Code_Bridge = "Not Found" |
0033 | Do While x > 0 |
0034 | Reference_Code_Bridge = "Found" |
0035 | Y = InStr(x + 1, strText_Local, "C+") |
0036 | 'Watch out for false positives in finding +C |
0037 | If Y = 0 Then |
0038 | x = x + 1 |
0039 | Else |
0040 | If Y - x > 100 Then |
0041 | x = x + 1 |
0042 | Else |
0043 | strCodeRef = Mid(strText_Local, x + 2, Y - x - 2) |
0044 | CodeRef = Trim(strCodeRef) |
0045 | If Y > Len(strText_Local) - 2 Then |
0046 | strText_End = "" |
0047 | Else |
0048 | strText_End = Mid(strText_Local, Y + 2, Len(strText_Local)) |
0049 | End If |
0050 | 'Determine Code Location |
0051 | CodeLocation = "" |
0052 | qryString = "SELECT Code_Table_Bridge.Procedure_Name, Code_Table_Bridge.Code_Location FROM Code_Table_Bridge WHERE (((Code_Table_Bridge.Procedure_Name)=""" & CodeRef & """));" |
0053 | Set rsTableToRead = CurrentDb.OpenRecordset(qryString) |
0054 | If Not rsTableToRead.EOF Then |
0055 | rsTableToRead.MoveFirst |
0056 | CodeLocation = rsTableToRead.Fields(1).Value |
0057 | strText_Local = Left(strText_Local, x - 1) & "" & CodeRef & "" & strText_End |
0058 | Else |
0059 | strText_Local = Left(strText_Local, x - 1) & CodeRef & strText_End |
0060 | x = x + 2 |
0061 | End If |
0062 | Set rsTableToRead = Nothing |
0063 | End If |
0064 | End If |
0065 | x = InStr(x, strText_Local, "+C") |
0066 | Loop |
0067 | strText = strText_Local |
0068 | End Function |