THEO TODMAN’S BRIDGE WEBSITES CODE PAGES



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

Table of Code Documentation Location 21 (10 items)

cmdChessResults_ClickcmdChessResultsExport_ClickcmdChessResultsList_ClickcmdCode_Documenter_Click
Document_Object_ColumnsTwo_ClubTwo_DiamondChess_Results_Export
Linked_Table_CountsParse_Mountnessing_Teams..

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

Go to top of page




Source Code of: Chess_Results_Export
Procedure Type: Public Sub
Module: Chess
Lines of Code: 171
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Chess_Results_Export()
0002'Create web-page of consolidated Chess results - this is the main page Chess_Results_Theo.htm
0003Dim strOutputFolder As String
0004Dim strOutputFile As String
0005Dim strLine As String
0006Dim rsTableControl As Recordset
0007Dim rsTableControl2 As Recordset
0008Dim fsoTextFileChess As FileSystemObject
0009Dim tsTextFileChess As TextStream
0010Dim j As Integer
0011Dim FileName As String
0012Dim iFields As Integer
0013Dim strControlQuery As String
0014Dim rsFooterControl As Recordset
0015Dim x
0016Dim ID As Integer
0017Dim Games As Integer
0018Dim Games_Tot As Integer
0019Dim Score_Tot As Double
0020Dim Grade_Tot As Double
0021Dim pgn_Col As Integer
0022strOutputFolder = "C:\Theo's Files\Websites\Theo's Website\Chess\"
0023Games_Tot = 0
0024Score_Tot = 0
0025Grade_Tot = 0
0026Set fsoTextFileChess = New FileSystemObject
0027FileName = "Chess_Results_Theo"
0028FileName = FileName & ".htm"
0029strOutputFile = strOutputFolder & FileName
0030Set tsTextFileChess = fsoTextFileChess.CreateTextFile(strOutputFile, True)
0031strLine = "<!DOCTYPE html><HTML lang=""en"">"
0032strLine = strLine & "<HEAD><meta charset=""utf-8""><TITLE>Theo Todman's Consolidated Chess Results Webpage</TITLE><link href=""../TheosStyle.css"" rel=""stylesheet"" type=""text/css""><link rel=""shortcut icon"" href=""../TT_ICO.png"" /></HEAD><BODY><H1>Theo Todman's Consolidated Chess Results</H1><CENTER>"
0033tsTextFileChess.WriteLine strLine
0034'Headings
0035 Set rsTableControl2 = CurrentDb.OpenRecordset("Chess_Results_Summary")
0036iFields = rsTableControl2.Fields.Count
0037If Not rsTableControl2.EOF Then
0038 rsTableControl2.MoveFirst
0039 strLine = "<p>&nbsp;</p><TABLE class = ""Bridge"" WIDTH=700>"
0040 tsTextFileChess.WriteLine strLine
0041End If
0042strLine = "<TR>"
0043tsTextFileChess.WriteLine strLine
0044j = 0
0045Do While j < iFields
0046 strLine = "<TH>" & rsTableControl2.Fields(j).Name & "</TH>"
0047 tsTextFileChess.WriteLine strLine
0048 j = j + 1
0049Loop
0050strLine = "</TR>"
0051tsTextFileChess.WriteLine strLine
0052Do While Not rsTableControl2.EOF
0053 strLine = "<TR>"
0054 tsTextFileChess.WriteLine strLine
0055 j = 0
0056 Do While j < iFields
0057 x = rsTableControl2.Fields(j)
0058 Select Case j
0059 Case 2
0060 x = Round(x, 0)
0061 Games_Tot = Games_Tot + x
0062 Games = x
0063 Case 3
0064 x = Round(x, 2)
0065 Score_Tot = Score_Tot + Games * x
0066 Case 4
0067 x = Round(x, 0)
0068 Grade_Tot = Grade_Tot + Games * x
0069 Case 5
0070 x = Round(x, 0)
0071 Case Else
0072 End Select
0073 strLine = "<TD>" & x & "</TD>"
0074 tsTextFileChess.WriteLine strLine
0075 j = j + 1
0076 Loop
0077 strLine = "</TR>"
0078 tsTextFileChess.WriteLine strLine
0079 rsTableControl2.MoveNext
0080Loop
0081'Totals
0082strLine = "<TR>"
0083tsTextFileChess.WriteLine strLine
0084j = 0
0085Do While j < iFields
0086 Select Case j
0087 Case 0
0088 x = "Total / Average"
0089 Case 2
0090 x = Games_Tot
0091 Case 3
0092 x = Round(Score_Tot / Games_Tot, 2)
0093 Case 4
0094 x = Round(Grade_Tot / Games_Tot, 0)
0095 Case Else
0096 x = "&nbsp;"
0097 End Select
0098 strLine = "<TH>" & x & "</TH>"
0099 tsTextFileChess.WriteLine strLine
0100 j = j + 1
0101Loop
0102strLine = "</TR>"
0103tsTextFileChess.WriteLine strLine
0104'Footer
0105strLine = "</TABLE><h3>For the actual games (where available) click on the 'PGN' Links in the table below</h3><h3>Games are displayed using pgn4web</h3>"
0106tsTextFileChess.WriteLine strLine
0107'Details
0108'Headings
0109 Set rsTableControl2 = CurrentDb.OpenRecordset("Chess_Results_List")
0110iFields = rsTableControl2.Fields.Count
0111If Not rsTableControl2.EOF Then
0112 rsTableControl2.MoveFirst
0113 strLine = "<TABLE class=""Bridge"" WIDTH=1200>"
0114 tsTextFileChess.WriteLine strLine
0115End If
0116strLine = "<TR>"
0117tsTextFileChess.WriteLine strLine
0118j = 0
0119Do While j < iFields
0120 strLine = "<TH>" & rsTableControl2.Fields(j).Name & "</TH>"
0121 tsTextFileChess.WriteLine strLine
0122 If rsTableControl2.Fields(j).Name = "pgn Link" Then
0123 pgn_Col = j
0124 End If
0125 j = j + 1
0126Loop
0127strLine = "</TR>"
0128tsTextFileChess.WriteLine strLine
0129'Text
0130Do While Not rsTableControl2.EOF
0131 strLine = "<TR>"
0132 tsTextFileChess.WriteLine strLine
0133 j = 0
0134 Do While j < iFields
0135 x = rsTableControl2.Fields(j) & ""
0136 If j = pgn_Col Then
0137 ID = rsTableControl2.Fields(0)
0138 OK = Chess_pgn_Page(ID)
0139 If OK = "OK" Then
0140 x = "<a href = ""Chess_Results_Theo_pgn_" & ID & ".htm"">PGN</a>"
0141 End If
0142 End If
0143 If x = "" Then
0144 x = "&nbsp;"
0145 End If
0146 strLine = "<TD>" & x & "</TD>"
0147 tsTextFileChess.WriteLine strLine
0148 j = j + 1
0149 Loop
0150 strLine = "</TR>"
0151 tsTextFileChess.WriteLine strLine
0152 rsTableControl2.MoveNext
0153Loop
0154'Footer
0155strLine = "</TABLE></CENTER>"
0156tsTextFileChess.WriteLine strLine
0157'Page Footer
0158strLine = ""
0159strControlTable = "Chess"
0160 strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Footer"")) ORDER BY Website_Control.Line;"
0161Set rsFooterControl = CurrentDb.OpenRecordset(strControlQuery)
0162rsFooterControl.MoveFirst
0163Do While Not rsFooterControl.EOF
0164 strLine = strLine & rsFooterControl.Fields(0)
0165 OK = Replace_Timestamp(strLine)
0166 rsFooterControl.MoveNext
0167Loop
0168tsTextFileChess.WriteLine strLine
0169 OK = CopyToTransfer(strOutputFolder, FileName)
0170Set tsTextFileChess = Nothing
0171End Sub

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



Source Code of: cmdChessResults_Click
Procedure Type: Private Sub
Module: Form_Bridge
Lines of Code: 6

Line-No. / Ref.Code Line
0001Private Sub cmdChessResults_Click()
0002 DoCmd.Close acTable, "Chess_Results"
0003 DoCmd.OpenTable "Chess_Results"
0004 DoCmd.Close acTable, "Chess_Grading_Periods"
0005 DoCmd.OpenTable "Chess_Grading_Periods"
0006End Sub

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



Source Code of: cmdChessResultsExport_Click
Procedure Type: Private Sub
Module: Form_Bridge
Lines of Code: 15

Line-No. / Ref.Code Line
0001Private Sub cmdChessResultsExport_Click()
0002If MsgBox("Output Theo's Consolidated Chess Results Webpages?", vbYesNo) <> vbYes Then
0003 Exit Sub
0004Else
0005 DoCmd.OpenTable ("Chess_Grading_Periods")
0006 If MsgBox("Have you set the Chess Reporting Periods?", vbYesNo) <> vbYes Then
0007 DoCmd.OpenTable "Chess_Grading_Periods"
0008 Exit Sub
0009 Else
0010 DoCmd.Close acTable, "Chess_Grading_Periods"
0011 End If
0012End If
0013 Chess_Results_Export
0014MsgBox ("Theo's Consolidated Chess Results Webpages Output OK")
0015End Sub

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



Source Code of: cmdChessResultsList_Click
Procedure Type: Private Sub
Module: Form_Bridge
Lines of Code: 6

Line-No. / Ref.Code Line
0001Private Sub cmdChessResultsList_Click()
0002 DoCmd.Close acQuery, "Chess_Results_List"
0003 DoCmd.OpenQuery "Chess_Results_List"
0004 DoCmd.Close acQuery, "Chess_Results_Summary"
0005 DoCmd.OpenQuery "Chess_Results_Summary"
0006End Sub

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



Source Code of: cmdCode_Documenter_Click
Procedure Type: Private Sub
Module: Form_Bridge
Lines of Code: 71
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdCode_Documenter_Click()
0002Dim strMessage As String
0003Dim StartTime As Double
0004Dim rsTableToRead As Recordset
0005Dim Duration As Double
0006Dim strRunTime As String
0007Dim RunTime As Double
0008Dim RunDate As Date
0009Dim MsgboxMsg As String
0010NoReusedQueryNames = 0
0011NoAmbiguousNames = 0
0012NoImages = 0
0013NoUnusedQueries = 0
0014NoUnusedVariables = 0
0015NoDeletedQueries = 0
0016NoDevelopmentLogItems = 0
0017SubSystem = "Bridge"
0018 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM BookPaperControl WHERE ID = ""Documentation_Generator_Bridge"";")
0019RunDate = rsTableToRead.Fields(1)
0020strRunTime = Round(rsTableToRead.Fields(2), 1)
0021strMessage = "Do you want to run the Bridge Application Documenter?" & Chr$(10) & "The ""Document_Tables_Full"" parameter is set to " & IIf(Document_Tables_Full = True, "True", "False") & Chr$(10) & "The ""Document_Queries_Full"" parameter is set to " & IIf(Document_Queries_Full = True, "True", "False")
0022strMessage = strMessage & Chr$(10) & "The last run on " & RunDate & " took " & strRunTime & " minutes."
0023RootCreated = ""
0024If MsgBox(strMessage, vbYesNo) = vbYes Then
0025 StartTime = Now()
0026 Documentation_Generator
0027 Duration = Round((Now() - StartTime) * 24 * 60, 1)
0028 rsTableToRead.Edit
0029 rsTableToRead.Fields(1) = Now()
0030 rsTableToRead.Fields(2) = Duration
0031 rsTableToRead.Update
0032Else
0033 Exit Sub
0034End If
0035MsgboxMsg = ""
0036MsgboxMsg = MsgboxMsg & "There are " & NoDevelopmentLogItems & " items in the Development Log." & Chr$(10)
0037If NoDeletedQueries = 0 Then
0038Else
0039 If NoDeletedQueries = 1 Then
0040 MsgboxMsg = MsgboxMsg & "There is " & NoDeletedQueries & " allegedly deleted Query in the database." & Chr$(10)
0041 Else
0042 MsgboxMsg = MsgboxMsg & "There are " & NoDeletedQueries & " allegedly deleted Queries in the database." & Chr$(10)
0043 End If
0044End If
0045If NoUnusedVariables <> 0 Then
0046 MsgboxMsg = MsgboxMsg & "There are " & NoUnusedVariables & " allegedly unused Variables in the database." & Chr$(10)
0047End If
0048MsgboxMsg = MsgboxMsg & "There are " & NoUnusedQueries & " allegedly unused Queries in the database." & Chr$(10)
0049If NoAmbiguousNames = 0 Then
0050Else
0051 If NoAmbiguousNames = 1 Then
0052 MsgboxMsg = MsgboxMsg & "There is " & NoAmbiguousNames & " ambiguous name in the Code."
0053 Else
0054 MsgboxMsg = MsgboxMsg & "There are " & NoAmbiguousNames & " ambiguous names in the Code."
0055 End If
0056 MsgboxMsg = MsgboxMsg & Chr$(10)
0057End If
0058If NoReusedQueryNames = 0 Then
0059Else
0060 If NoReusedQueryNames = 1 Then
0061 MsgboxMsg = MsgboxMsg & "There is " & NoReusedQueryNames & " re-used Query Name. "
0062 Else
0063 MsgboxMsg = MsgboxMsg & "There are " & NoReusedQueryNames & " re-used Query Names."
0064 End If
0065 MsgboxMsg = MsgboxMsg & Chr$(10)
0066End If
0067MsgboxMsg = MsgboxMsg & Chr$(10) & Chr$(10)
0068MsgBox (MsgboxMsg & "The lists follow ... Investigate them and consider pruning. " & Chr$(10) & Chr$(10) & "Documentation Complete in " & Duration & " minutes.")
0069MsgBox ("Now output the Note 1001")
0070Set rsTableToRead = Nothing
0071End Sub

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



Source Code of: Document_Object_Columns
Procedure Type: Public Function
Module: Documentation
Lines of Code: 129
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Document_Object_Columns(Object, Object_Type, Calling_File, MainText, Links)
0002Dim tsTextFileTab As TextStream
0003Dim strControlQuery As String
0004Dim rsTableControlTab As Recordset
0005Dim rsTableFields As Recordset
0006Dim strLine As String
0007Dim i As Integer
0008Dim FieldType As String
0009Dim strPrefix As String
0010Dim rsTableControl As Recordset
0011strControlTable = "DocumentationControl"
0012'Create File
0013If Object_Type = "Table" Then
0014 strOutputFileShort = SubSystem & "Documentation_Tables_"
0015Else
0016 strOutputFileShort = SubSystem & "Documentation_Queries_"
0017End If
0018strOutputFileShort = strOutputFileShort & Object
0019strOutputFileShort = Replace(strOutputFileShort, "?", "")
0020Set tsTextFileTab = fsoTextFile2.CreateTextFile(strOutputFolder & strOutputFileShort & ".htm", True, True)
0021'Create Page Header
0022 strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Header"")) ORDER BY Website_Control.Line;"
0023Set rsTableControlTab = CurrentDb.OpenRecordset(strControlQuery)
0024rsTableControlTab.MoveFirst
0025Do While Not rsTableControlTab.EOF
0026 strLine = rsTableControlTab.Fields(0) & ""
0027 tsTextFileTab.WriteLine strLine
0028 rsTableControlTab.MoveNext
0029Loop
0030strLine = MainText & "<br>"
0031tsTextFileTab.WriteLine strLine
0032strLine = "<U><B>Columns for " & Object_Type & ": " & Object & "</U></B><BR><BR>"
0033tsTextFileTab.WriteLine strLine
0034'Read the table columns
0035strControlQuery = "SELECT [" & Object & "].* FROM [" & Object & "];"
0036On Error GoTo Failed
0037Set rsTableFields = CurrentDb.OpenRecordset(strControlQuery)
0038strLine = "<OL>"
0039tsTextFileTab.WriteLine strLine
0040For i = 1 To rsTableFields.Fields.Count
0041 FieldType = rsTableFields.Fields(i - 1).Type
0042 Select Case FieldType
0043 Case dbBigInt
0044 FieldType = "Big Integer"
0045 Case dbBinary
0046 FieldType = "Binary"
0047 Case dbBoolean
0048 FieldType = "Boolean"
0049 Case dbByte
0050 FieldType = "Byte"
0051 Case dbChar
0052 FieldType = "Char"
0053 Case dbCurrency
0054 FieldType = "Currency"
0055 Case dbDate
0056 FieldType = "Date/Time"
0057 Case dbDecimal
0058 FieldType = "Decimal"
0059 Case dbDouble
0060 FieldType = "Double"
0061 Case dbFloat
0062 FieldType = "Float"
0063 Case dbGUID
0064 FieldType = "GUID"
0065 Case dbInteger
0066 FieldType = "Integer"
0067 Case dbLong
0068 FieldType = "Long"
0069 Case dbLongBinary
0070 FieldType = "Long Binary (OLE Object)"
0071 Case dbMemo
0072 FieldType = "Memo"
0073 Case dbNumeric
0074 FieldType = "Numeric"
0075 Case dbSingle
0076 FieldType = "Single"
0077 Case dbText
0078 FieldType = "Text"
0079 Case dbTime
0080 FieldType = "Time"
0081 Case dbTimeStamp
0082 FieldType = "Time Stamp"
0083 Case dbVarBinary
0084 FieldType = "VarBinary"
0085 Case Else
0086 FieldType = "Unknown Field Type (" & FieldType & ")"
0087 End Select
0088 strLine = "<LI>" & rsTableFields.Fields(i - 1).Name & " (" & FieldType & ")</li>"
0089 tsTextFileTab.WriteLine strLine
0090Next i
0091Failed:
0092If Err.Number > 0 Then
0093 If Object_Type = "Query" Then
0094 strLine = "<OL><LI>Permission Denied - Action Query</li>"
0095 Else
0096 strLine = "<OL><LI>Permission Denied - System Table</li>"
0097 End If
0098 tsTextFileTab.WriteLine strLine
0099End If
0100strLine = "</OL>"
0101tsTextFileTab.WriteLine strLine
0102strLine = Links
0103tsTextFileTab.WriteLine strLine
0104'Create return Link
0105If Object_Type = "Query" Then
0106 Set rsTableControlTab = CurrentDb.OpenRecordset("SELECT Query_Definitions.Query_Type FROM Query_Definitions WHERE Query_Definitions.Query_Name = """ & Object & """;")
0107 rsTableControlTab.MoveFirst
0108 strPrefix = "_" & rsTableControlTab.Fields(0).Value
0109Else
0110 strPrefix = ""
0111End If
0112strLine = "<A HREF=""" & Calling_File & strPrefix & ".htm#" & Object & """>Return Link to " & Object_Type & """" & Object & """ Control Page</A><br>"
0113tsTextFileTab.WriteLine strLine
0114'Create link to main code jump-table
0115strLine = "<A HREF=""" & SubSystem & "DocumentationControl.htm"">Link to VBA Code Control Page</A><br>"
0116tsTextFileTab.WriteLine strLine
0117'Page Footer
0118 strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Footer"")) ORDER BY Website_Control.Line;"
0119Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0120rsTableControl.MoveFirst
0121Do While Not rsTableControl.EOF
0122 strLine = rsTableControl.Fields(0)
0123 OK = Replace_Timestamp(strLine)
0124 tsTextFileTab.WriteLine strLine
0125 rsTableControl.MoveNext
0126Loop
0127 OK = CopyToTransfer(strFolder & "\", strOutputFileShort & ".htm")
0128Set tsTextFileTab = Nothing
0129End Function

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



Source Code of: Linked_Table_Counts
Procedure Type: Public Sub
Module: Documentation
Lines of Code: 33
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Linked_Table_Counts()
0002Dim rsTableToRead As Recordset
0003Dim rsTableToWrite As Recordset
0004Dim strQuery As String
0005Dim Table As String
0006Dim First_Column As String
0007Dim i As Long
0008 Set rsTableToWrite = CurrentDb.OpenRecordset("SELECT Table_Definitions.Table_Name, Table_Definitions.Table_RecordCount, Left([Table_Connect],5) & """" AS Expr1 FROM Table_Definitions WHERE (((Left([Table_Connect],5) & """")<>"""" And (Left([Table_Connect],5) & """")<>""Excel""));")
0009rsTableToWrite.MoveFirst
0010Do While Not rsTableToWrite.EOF
0011 Table = rsTableToWrite.Fields(0).Value
0012 strQuery = "SELECT " & Table & ".* FROM " & Table & ";"
0013 Set rsTableToRead = CurrentDb.OpenRecordset(strQuery)
0014 If Not rsTableToRead.EOF Then
0015 rsTableToRead.MoveFirst
0016 First_Column = rsTableToRead.Fields(0).Name
0017 Set rsTableToRead = Nothing
0018 strQuery = "SELECT Count(" & Table & "." & First_Column & ") AS Counter FROM " & Table & ";"
0019 Set rsTableToRead = CurrentDb.OpenRecordset(strQuery)
0020 rsTableToRead.MoveFirst
0021 i = rsTableToRead.Fields(0)
0022 Else
0023 i = 0
0024 End If
0025 Set rsTableToRead = Nothing
0026 rsTableToWrite.Edit
0027 rsTableToWrite.Fields(1) = i
0028 rsTableToWrite.Update
0029 rsTableToWrite.MoveNext
0030Loop
0031Set rsTableToRead = Nothing
0032Set rsTableToWrite = Nothing
0033End Sub

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



Source Code of: Parse_Mountnessing_Teams
Procedure Type: Public Sub
Module: ScorebridgeConvertion
Lines of Code: 11

Line-No. / Ref.Code Line
0001Public Sub Parse_Mountnessing_Teams(strLine, Club, strDateTemp)
0002Dim i As Long
0003'Joint Project database - Check format for Mountnessing Teams
0004'Find Format and call the relevant module ...
0005i = InStr(strLine, "ScoreBridge from www.scorebridge.com")
0006If i > 0 Then
0007 Call Parse_WebPage_Scorebridge_Teams(strLine, Club, strDateTemp)
0008Else
0009 Call Parse_WebPage_JeffSmith_Teams(strLine, Club, strDateTemp)
0010End If
0011End Sub

Procedures Calling This Procedure (Parse_Mountnessing_Teams) Procedures Called By This Procedure (Parse_Mountnessing_Teams) Go To Top of This Page
Link to VBA Code Control Page



Source Code of: Two_Club
Procedure Type: Public Function
Module: HandDealing
Lines of Code: 17

Line-No. / Ref.Code Line
0001Public Function Two_Club()
0002Dim Two_ClubTemp As String
0003Two_ClubTemp = ""
0004If (N_Points > 18) And (N_Points < 23) Then
0005 Two_ClubTemp = "N"
0006End If
0007If (E_Points > 18) And (E_Points < 23) Then
0008 Two_ClubTemp = Two_ClubTemp & "E"
0009End If
0010If (S_Points > 18) And (S_Points < 23) Then
0011 Two_ClubTemp = Two_ClubTemp & "S"
0012End If
0013If (W_Points > 18) And (W_Points < 23) Then
0014 Two_ClubTemp = Two_ClubTemp & "W"
0015End If
0016Two_Club = Two_ClubTemp
0017End Function

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



Source Code of: Two_Diamond
Procedure Type: Public Function
Module: HandDealing
Lines of Code: 17

Line-No. / Ref.Code Line
0001Public Function Two_Diamond()
0002Dim Two_DiamondTemp As String
0003Two_DiamondTemp = ""
0004If N_Points > 22 Then
0005 Two_DiamondTemp = "N"
0006End If
0007If E_Points > 22 Then
0008 Two_DiamondTemp = Two_DiamondTemp & "E"
0009End If
0010If S_Points > 22 Then
0011 Two_DiamondTemp = Two_DiamondTemp & "S"
0012End If
0013If W_Points > 22 Then
0014 Two_DiamondTemp = Two_DiamondTemp & "W"
0015End If
0016Two_Diamond = Two_DiamondTemp
0017End Function

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



© Theo Todman, June 2007 - July 2020 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 Bridge Page Return to Theo Todman's Home Page