这是连接部分,麻烦各位帮我看看,谢谢!
Sub Initialize()
' Those three variables are used to convert the BOGO instructions to upper case
Dim intRow As Integer
Dim intCol As Integer
Dim intMaxRow As Integer
' Reset the position on the board to top left corner
mintRow = 3
mintCol = 6
' Clear the board
Range("F3:Y22").Clear
' Convert the BOGO instructions to upper case and clear the color of the buggy line from previous run (if any)
intMaxRow = Application.CountA(Range("A:A")) + 1
For intRow = 4 To intMaxRow
For intCol = 1 To 3
Cells(intRow, intCol).Value = UCase(Cells(intRow, intCol).Value)
Cells(intRow, intCol).Interior.ColorIndex = xlColorIndexNone
Next intCol
Next intRow
End Sub
--------------------------------------------
Sub ValTest()
Range("AB24:AB100").Clear
Dim intCommentLine As Integer
Dim intCurLine As Integer
intCommentLine = 24
intCurLine = 10000
Dim blnTest As Boolean
'***Test Valid Inputs***
'Test Left
Cells(intCurLine, 1).Value = "L"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "RED"
blnTest = Sheets("Draw").Validate(intCurLine)
'Test Right
Cells(intCurLine, 1).Value = "R"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "RED"
blnTest = blnTest And Sheets("Draw").Validate(intCurLine)
'Test Up
Cells(intCurLine, 1).Value = "U"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "RED"
blnTest = blnTest And Sheets("Draw").Validate(intCurLine)
'Test Down
Cells(intCurLine, 1).Value = "D"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "RED"
blnTest = blnTest And Sheets("Draw").Validate(intCurLine)
'Test Blue
Cells(intCurLine, 1).Value = "R"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "BLUE"
blnTest = blnTest And Sheets("Draw").Validate(intCurLine)
'Test Green
Cells(intCurLine, 1).Value = "R"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "GREEN"
blnTest = blnTest And Sheets("Draw").Validate(intCurLine)
'Test Yellow
Cells(intCurLine, 1).Value = "R"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "YELLOW"
blnTest = blnTest And Sheets("Draw").Validate(intCurLine)
'Test Cyan
Cells(intCurLine, 1).Value = "R"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "CYAN"
blnTest = blnTest And Sheets("Draw").Validate(intCurLine)
'Test Magenta
Cells(intCurLine, 1).Value = "R"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "MAGENTA"
blnTest = blnTest And Sheets("Draw").Validate(intCurLine)
'Test Black
Cells(intCurLine, 1).Value = "R"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "BLACK"
blnTest = blnTest And Sheets("Draw").Validate(intCurLine)
'Test White
Cells(intCurLine, 1).Value = "R"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "WHITE"
blnTest = blnTest And Sheets("Draw").Validate(intCurLine)
'Test Blank
Cells(intCurLine, 1).Value = "R"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = ""
blnTest = blnTest And Sheets("Draw").Validate(intCurLine)
If blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Validate Works Correctly for Valid Input"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Validate Does NOT Work Correctly for Valid Input"
End If
'***Done Testing Valid Inputs***
intCommentLine = intCommentLine + 1
blnTest = True
'Test Invalid Direction
Cells(intCurLine, 1).Value = "B"
Cells(intCurLine, 2).Value = "5"
Cells(intCurLine, 3).Value = "RED"
blnTest = Sheets("Draw").Validate(intCurLine)
If Not blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Validate Catches Invalid Direction Appropriately"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Validate Does NOT Catch Invalid Direction Appropriately"
End If
intCommentLine = intCommentLine + 1
blnTest = True
'Test Invalid Num Cells
Cells(intCurLine, 1).Value = "D"
Cells(intCurLine, 2).Value = "0"
Cells(intCurLine, 3).Value = "RED"
blnTest = Sheets("Draw").Validate(intCurLine)
Cells(intCurLine, 1).Value = "D"
Cells(intCurLine, 2).Value = "21"
Cells(intCurLine, 3).Value = "RED"
blnTest = blnTest Or Sheets("Draw").Validate(intCurLine)
Cells(intCurLine, 1).Value = "D"
Cells(intCurLine, 2).Value = "-5"
Cells(intCurLine, 3).Value = "RED"
blnTest = blnTest Or Sheets("Draw").Validate(intCurLine)
If Not blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Validate Catches Invalid Num Cells Appropriately"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Validate Does NOT Catch Invalid Num Cells Appropriately"
End If
intCommentLine = intCommentLine + 1
blnTest = True
'Test Invalid Colors
Cells(intCurLine, 1).Value = "D"
Cells(intCurLine, 2).Value = "1"
Cells(intCurLine, 3).Value = "RD"
blnTest = Sheets("Draw").Validate(intCurLine)
If Not blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Validate Catches Invalid Colors Appropriately"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Validate Does NOT Catch Invalid Colors Appropriately"
End If
Range("A10000:C10000").Clear
End Sub
--------------------------------------------
Sub ColorTest()
Dim intRow As Integer
Dim intCol As Integer
Dim intCommentLine As Integer
Dim blnTest As Boolean
intRow = 10000
intCol = 1
intCommentLine = 24
Range("A10000:C10000").Clear
Range("AB24:AB100").Clear
Sheets("Draw").ColorCell "RED", intRow, intCol
blnTest = Cells(intRow, intCol).Interior.Color = vbRed
If blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Coloring red works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Coloring red does NOT work"
End If
intCommentLine = intCommentLine + 1
Sheets("Draw").ColorCell "GREEN", intRow, intCol
blnTest = Cells(intRow, intCol).Interior.Color = vbGreen
If blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Coloring green works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Coloring green does NOT work"
End If
intCommentLine = intCommentLine + 1
Sheets("Draw").ColorCell "BLUE", intRow, intCol
blnTest = Cells(intRow, intCol).Interior.Color = vbBlue
If blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Coloring blue works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Coloring blue does NOT work"
End If
intCommentLine = intCommentLine + 1
Sheets("Draw").ColorCell "CYAN", intRow, intCol
blnTest = Cells(intRow, intCol).Interior.Color = vbCyan
If blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Coloring cyan works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Coloring cyan does NOT work"
End If
intCommentLine = intCommentLine + 1
Sheets("Draw").ColorCell "MAGENTA", intRow, intCol
blnTest = Cells(intRow, intCol).Interior.Color = vbMagenta
If blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Coloring magenta works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Coloring magenta does NOT work"
End If
intCommentLine = intCommentLine + 1
Sheets("Draw").ColorCell "YELLOW", intRow, intCol
blnTest = Cells(intRow, intCol).Interior.Color = vbYellow
If blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Coloring yellow works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Coloring yellow does NOT work"
End If
intCommentLine = intCommentLine + 1
Sheets("Draw").ColorCell "BLACK", intRow, intCol
blnTest = Cells(intRow, intCol).Interior.Color = vbBlack
If blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Coloring black works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Coloring black does NOT work"
End If
intCommentLine = intCommentLine + 1
Sheets("Draw").ColorCell "WHITE", intRow, intCol
blnTest = Cells(intRow, intCol).Interior.Color = vbWhite
If blnTest Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Coloring white works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Coloring white does NOT work"
End If
Range("A10000:C10000").Clear
End Sub
--------------------------------------------
Sub MoveTest()
Dim intCommentLine As Integer
intCommentLine = 24
Dim blnTest As Boolean
Range("A10000:C10000").Clear
Range("AB24:AB100").Clear
'Test move left
mintRow = 10
mintCol = 10
blnTest = Sheets("Draw").MoveOneCell("L")
If (blnTest And (mintCol = 9) And (mintRow = 10)) Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Move left works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Move left does NOT work"
End If
'Test move right
intCommentLine = intCommentLine + 1
mintRow = 10
mintCol = 10
blnTest = Sheets("Draw").MoveOneCell("R")
If (blnTest And (mintCol = 11) And (mintRow = 10)) Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Move right works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Move right does NOT work"
End If
'Test move up
intCommentLine = intCommentLine + 1
mintRow = 10
mintCol = 10
blnTest = Sheets("Draw").MoveOneCell("U")
If (blnTest And (mintRow = 9) And (mintCol = 10)) Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Move up works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Move up does NOT work"
End If
'Test move down
intCommentLine = intCommentLine + 1
mintRow = 10
mintCol = 10
blnTest = Sheets("Draw").MoveOneCell("D")
If (blnTest And (mintRow = 11) And (mintCol = 10)) Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Move down works"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Move down does NOT work"
End If
'Test Left Boundary
intCommentLine = intCommentLine + 1
mintRow = 10
mintCol = 6
blnTest = Sheets("Draw").MoveOneCell("L")
If (Not blnTest And (mintCol = 6)) Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Painting stops correctly at left boundary"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Painting does NOT stop correctly at left boundary"
End If
'Test Right Boundary
intCommentLine = intCommentLine + 1
mintRow = 10
mintCol = 25
blnTest = Sheets("Draw").MoveOneCell("R")
If (Not blnTest And (mintCol = 25)) Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Painting stops correctly at right boundary"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Painting does NOT stop correctly at right boundary"
End If
'Test Upper Boundary
intCommentLine = intCommentLine + 1
mintRow = 3
mintCol = 10
blnTest = Sheets("Draw").MoveOneCell("U")
If (Not blnTest And (mintRow = 3)) Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Painting stops correctly at top boundary"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Painting does NOT stop correctly at top boundary"
End If
'Test Bottom Boundary
intCommentLine = intCommentLine + 1
mintRow = 22
mintCol = 10
blnTest = Sheets("Draw").MoveOneCell("D")
If (Not blnTest And (mintRow = 22)) Then
Cells(intCommentLine, 28).Font.Color = vbBlack
Cells(intCommentLine, 28).Value = "Painting stops correctly at bottom boundary"
Else
Cells(intCommentLine, 28).Font.Color = vbRed
Cells(intCommentLine, 28).Value = "Painting does NOT stop correctly at bottom boundary"
End If
End Sub