Wednesday, December 16, 2009

Excel testsuite controller

Private Sub allset_Click()
On Error Resume Next

last = Range("B1000").End(xlUp).Row
Dim c As Range, myRange As Range
Set myRange = Selection
For Each c In myRange.Cells
ActiveSheet.CheckBoxes.Add(c.Left, c.Top, c.Width - 20, c.Height - 30).Select
With Selection

.LinkedCell = c.Address
.Characters.Text = "T"
.Name = c.Address
.Value = xlOn
.Caption = "chk" & Left(Range("A" & c.Row).Value, 3)
.Name = "chk" & Left(Range("A" & c.Row).Value, 3)

End With
c.Select
With Selection
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, _
Formula1:="=" & c.Address & "=TRUE"
.FormatConditions(1).Font.ColorIndex = 4 'change for other color when ticked
.FormatConditions(1).Interior.ColorIndex = 4 'change for other color when ticked
.Font.ColorIndex = 3 'cell background color = White
.Interior.ColorIndex = 3
End With

Next
myRange.Select
End Sub

Private Sub CheckBox1_Click()
Dim i As Integer
If CheckBox1.Value Then

Range("c4").Interior.ColorIndex = 4

For i = 1 To 5
ActiveSheet.OLEObjects("CheckBox" & i + 1).Object.Value = 1
Range("c" & i + 4).Interior.ColorIndex = 4
Range("c" & i + 4).Value = "T"
Next i
Else
Range("c4").Interior.ColorIndex = 3
For i = 1 To 5
ActiveSheet.OLEObjects("CheckBox" & i + 1).Object.Value = 0
Range("c" & i + 4).Interior.ColorIndex = 3
Range("c" & i + 4).Value = "F"
Next i
End If
End Sub

Private Sub CheckBox2_Click()
If CheckBox2.Value Then
Range("C5").Interior.ColorIndex = 4
Else
Range("C5").Interior.ColorIndex = 3
End If



End Sub

Private Sub CheckBox3_Click()
If CheckBox3.Value Then
Range("C6").Interior.ColorIndex = 4
Else
Range("C6").Interior.ColorIndex = 3
End If
End Sub

Private Sub CheckBox4_Click()
If CheckBox4.Value Then
Range("C7").Interior.ColorIndex = 4
Else
Range("C7").Interior.ColorIndex = 3
End If
End Sub

Private Sub CheckBox5_Click()
If CheckBox5.Value Then
Range("C8").Interior.ColorIndex = 4
Else
Range("C8").Interior.ColorIndex = 3
End If
End Sub

Private Sub CheckBox6_Click()
If CheckBox6.Value Then
Range("C9").Interior.ColorIndex = 4
Else
Range("C9").Interior.ColorIndex = 3
End If
End Sub

Private Sub chkallset_Click()
Dim i As Integer
last = Range("A1000").End(xlUp).Row
last = last + 1
If chkallset.Value Then

Range("B3").Interior.ColorIndex = 6
j = 101

For i = 1 To last - 3

If Range("B" & i + 3).Interior.ColorIndex <> -4142 Then

ActiveSheet.CheckBoxes("chk" & j).Value = 1
'Range("c" & i + 4).Interior.ColorIndex = 6
j = j + 1

Else
j = j + 1
End If
Next i
Else
Range("B3").Interior.ColorIndex = 3
j = 101
For i = 1 To last - 3

If Range("B" & i + 3).Interior.ColorIndex <> -4142 Then

ActiveSheet.CheckBoxes("chk" & j).Value = 0
'Range("c" & i + 4).Interior.ColorIndex = 3
j = j + 1
Else
j = j + 1
End If
Next

End If
End Sub

Private Sub CommandButton2_Click()
Dim x
Dim day1, day2, day3, day4, day5, day6, day7 As Integer
Dim dd As String
Dim ft As Integer

Set oService = GetObject("winmgmts:")
Set oJob = oService.Get("Win32_ScheduledJob")
If Range("F5").Value = 1 Then

x = Range("Mdate").Value
z = "********" + x + "00.000000-420"
oJob.Create "Notepad.exe", z, True, 1, , , JobID
Range("F6").Value = JobID
Else
Range("F6").Value = ""
End If
If Range("G5").Value = 1 Then
x = Range("Tdate").Value
z = "********" + x + "00.000000-420"
oJob.Create "Notepad.exe", z, True, 2, , , JobID
Range("G6").Value = JobID
Else
Range("G6").Value = ""
End If
If Range("H5").Value = 1 Then
x = Range("Wdate").Value
z = "********" + x + "00.000000-420"
oJob.Create "Notepad.exe", z, True, 4, , , JobID
Range("H6").Value = JobID
Else
Range("H6").Value = ""
End If
If Range("I5").Value = 1 Then
x = Range("Thdate").Value
z = "********" + x + "00.000000-420"
oJob.Create "Notepad.exe", z, True, 8, , , JobID
Range("I6").Value = JobID
Else
Range("I6").Value = ""
End If
If Range("J5").Value = 1 Then
x = Range("Fdate").Value
z = "********" + x + "00.000000-420"
oJob.Create "Notepad.exe", z, True, 16, , , JobID
Range("J6").Value = JobID
Else
Range("J6").Value = ""
End If
If Range("K5").Value = 1 Then
x = Range("Sdate").Value
z = "********" + x + "00.000000-420"
oJob.Create "Notepad.exe", z, True, 32, , , JobID
Range("K6").Value = JobID
Else
Range("K6").Value = ""
End If
If Range("L5").Value = 1 Then
x = Range("Sudate").Value
z = "********" + x + "00.000000-420"
oJob.Create "Notepad.exe", z, True, 64, , , JobID
Range("L6").Value = JobID
Else
Range("L6").Value = ""
End If

End Sub

Private Sub Deletesch_Click()
Set odService1 = GetObject("winmgmts:")
Dim A(10) As Integer
A(1) = Range("F6").Value
A(2) = Range("G6").Value
A(3) = Range("H6").Value
A(4) = Range("I6").Value
A(5) = Range("J6").Value
A(6) = Range("K6").Value
A(7) = Range("L6").Value

For i = 1 To 7
If A(i) >= 1 And A(i) < 1000 Then

Set objInstance = odService1.Get("Win32_ScheduledJob.JobID=" & A(i))
objInstance.Delete
Set objInstance = Nothing

End If
Next
Range("F6").Value = ""
Range("G6").Value = ""
Range("H6").Value = ""
Range("I6").Value = ""
Range("J6").Value = ""
Range("K6").Value = ""
Range("L6").Value = ""
End Sub

Private Sub res_Click()
Dim i As Integer
Dim counter As Integer
Dim lastc As Integer
Dim tempc As Integer
tempc = 0
last = Range("E1000").End(xlUp).Row

lastc = 0
counter1 = 0
For i = 4 To last - 3
If Range("E" & i).Value = "Pass" Then

counter1 = counter1 + 1
ElseIf Range("E" & i).Value = "Fail" Then
lastc = lastc + 1
Else
tempc = tempc + 1
End If
Next

Range("F15").Value = lastc + counter1
Range("F16").Value = counter1
Range("F17").Value = lastc

With ActiveSheet.ChartObjects.Add _
(Left:=500, Width:=375, Top:=500, Height:=225)
.Chart.SetSourceData Source:=Sheets("Sheet1").Range("F15:F17")

.Chart.HasTitle = True
.Chart.ChartTitle.Text = Range("A1").Value & " " & Date
' for y axis
.Chart.Axes(xlValue, xlPrimary).HasTitle = True
.Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "col 1 for total run, col 2 for pass, col 3 for fail"
.Chart.Axes(xlCategory, xlPrimary).HasTitle = True
.Chart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = " total run " & lastc + counter1 & " ,Pass " & counter1 & ", Fail " & lastc & ",Unrun count " & tempc & "."
.Chart.Export Filename:="c:\current_sales.gif", FilterName:="GIF"
End With

End Sub

No comments:

Post a Comment