RTM Report Query

URS linked to FS , FS linked to other risk reqs and Test Coverage

SELECT D.RQ_REQ_ID AS "URS ID",
D.RQ_REQ_NAME AS "URS NAME",
D.RQ_USER_TEMPLATE_21 AS "URS CLASSIFICATION",
D.RQ_REQ_PRIORITY AS "URS PRIORITY",
D.RQ_REQ_COMMENT AS "URS DESCRIPTION",
A.RT_TO_REQ_ID AS "FS ID",
E.RQ_REQ_NAME AS "FS NAME",
RC_ENTITY_ID AS "FS TEST ID",
TS_NAME AS "FS TEST NAME",
B.RT_TO_REQ_ID AS "RISK ID",
C.RQ_REQ_NAME AS "RISK NAME",
C.RQ_USER_TEMPLATE_26 AS "ADDITIONALVERIFICATIONS",
C.RQ_USER_TEMPLATE_25 AS "REQUIRED TEST STRATEGY"
FROM REQ D
LEFT OUTER JOIN REQ_TYPE
ON D.RQ_TYPE_ID = TPR_TYPE_ID
LEFT OUTER JOIN REQ_TRACE A
ON A.RT_FROM_REQ_ID = RQ_REQ_ID
LEFT OUTER JOIN REQ_TRACE B
ON A.RT_TO_REQ_ID = B.RT_FROM_REQ_ID
LEFT OUTER JOIN REQ_COVER
ON RC_REQ_ID = A.RT_TO_REQ_ID
LEFT OUTER JOIN TEST
ON RC_ENTITY_ID = TS_TEST_ID
LEFT OUTER JOIN REQ C
ON B.RT_TO_REQ_ID = C.RQ_REQ_ID
LEFT OUTER JOIN REQ E
ON A.RT_TO_REQ_ID = E.RQ_REQ_ID
WHERE TPR_NAME = 'URS'

Should not be able to fail run step without having/linking atleast one defect

Function Step_FieldCanChange(FieldName, NewValue)
On Error Resume Next

if FieldName= "ST_STATUS" then
if Step_Fields("ST_ACTUAL").Value = "" then
Msgbox "Actual Result cannot be empty"
Step_FieldCanChange = False
Exit Function
else
Step_FieldCanChange = DefaultRes
end if

'If the new value is going to be Failed or Blocked...
If NewValue = "Failed" or NewValue = "Blocked" Then

'Get the Step ID of the current Step.
StepID = Step_Fields.Field("ST_ID").Value

'Get the Step factory from the StepID
Set StepFact = TDConnection.StepFactory

'Get the Step object from the Step Factory
Set StepObj = StepFactory.Item(StepID)

'Get the BugLinkFactory from the Step
Set BugLinkFact = StepObj.BugLinkFactory

'Set a blank filter to find all the current defects in the BugLinkFactory
Set BugLinkFactFilter = BugLinkFact.Filter

'Apply the filter and add the filtered items to a list
Set BugLinkFactList = BugLinkFactFilter.NewList

'Check the list to see if it is empty
If BugLinkFactList.Count = 0 Then
'Inform the user.
MsgBox "You must link a defect."
'Block the status change
Step_FieldCanChange = False
'leave
Exit Function
else
Step_FieldCanChange = DefaultRes
End If

'Kill the objects
Set BugLinkFactList = Nothing
Set BugLinkFactFilter = Nothing
Set BugLinkFact = Nothing
Set StepObj = Nothing
Set StepFact = Nothing

End If
end if
On Error GoTo 0
End Function

Restrict Test Cases which are not in Ready status from getting pulled into test set

Function TestSet_CanAddTests(Tests)
On Error Resume Next
Dim TD, TF, TS, n, result, tmp_msg, vb_result
Set TD = TDconnection
Set TF = TD.TestFactory
tmp_msg = ""

For i = 0 To UBound(Tests)
n = Tests(i)
Set TS = TF(n)
'msgbox Cstr(TS.Field("TS_STATUS"))
If CStr(TS.Field("TS_STATUS")) "Ready" Then
tmp_msg = tmp_msg & vbCrLf & " - " & TS.Field("TS_NAME")
End If
Next

If tmp_msg "" Then
result = "The following test(s) has are not ready :" & vbCrLf & _
tmp_msg & vbCrLf & vbCrLf & "Add test(s) anyway?"
vb_result = MsgBox(result, vbQuestion + vbYesNo)
If vb_result = vbNo Then
TestSet_CanAddTests = False
Else
TestSet_CanAddTests = DefaultRes
End If
End If

Set TS = Nothing
Set TF = Nothing
Set TD = Nothing
'TestSet_CanAddTests = DefaultRes
On Error GoTo 0
End Function


Defect Age report

SQL
SELECT
bg_bug_id as "Defect ID",
BG_PROJECT as "Project" /*Defect.Project*/,
BG_USER_21 as "Cycle" /*Defect.Testing Cycle*/,
cast(min(au_time)as date) as FirstLog,
cast(max(au_time) as date) as LastLog ,
trunc (max(au_time)- min(au_time)) as "Processing Time in Days",
bg_status as CurrentStatus
FROM
bug left outer join audit_log
on bg_bug_id = au_entity_id
left outer join audit_properties
on au_action_id = ap_action_id
where au_entity_type = 'BUG'
group by bg_bug_id, bg_Status,bg_project,bg_user_21
having bg_user_21 in ( 'QA','UAT') and ( cast(min(au_time)as date) between TO_DATE('01-10-2018','DD-MM-YYYY') and TO_DATE('31-12-2018','DD-MM-YYYY'))
order by bg_bug_id
post processing code

Sub QC_PostProcessing()
Sheets("Query1").Select
Range("A1").Select
Range("A1:G1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("I1").Select
CreatePivotTable
CreatePivotChartEmbedded
Format_Data
End Sub
Sub CreatePivotTable()

Dim pc As PivotCache
Dim ws As Worksheet
Dim pt As PivotTable
Dim wsMovies As Worksheet

Set wsMovies = ThisWorkbook.Sheets("Query1")

Set pc = ThisWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=wsMovies.Name & "!" & wsMovies.Range("A1").CurrentRegion.Address, _
Version:=xlPivotTableVersion15)

wsMovies.Range("I1").Select

Set pt = pc.CreatePivotTable( _
TableDestination:=ActiveCell, _
TableName:="MoviePivot")

wsMovies.Range("I1").Select

With ActiveSheet.PivotTables("MoviePivot").PivotFields("Cycle")
.Orientation = xlPageField
.Position = 1
End With

With ActiveSheet.PivotTables("MoviePivot").PivotFields( _
"Processing Time in Days")
.Orientation = xlRowField
.Position = 1
End With

With ActiveSheet.PivotTables("MoviePivot").PivotFields( _
"Project")
.Orientation = xlRowField
.Position = 1
End With

ActiveSheet.PivotTables("MoviePivot").AddDataField ActiveSheet.PivotTables( _
"MoviePivot").PivotFields("Defect ID"), "Sum of Defect ID", xlSum
With ActiveSheet.PivotTables("MoviePivot").PivotFields("Sum of Defect ID")
.Caption = "Count of Defect ID"
.Function = xlCount
End With

Range("I7").Select
Selection.Group Start:=True, End:=True, By:=11

With ActiveSheet.PivotTables("MoviePivot").PivotFields("CURRENTSTATUS")
.Orientation = xlColumnField
.Position = 1
End With

ActiveSheet.PivotTables("MoviePivot").PivotFields("Cycle").CurrentPage = _
"(All)"
ActiveSheet.PivotTables("MoviePivot").PivotFields("Cycle"). _
EnableMultiplePageItems = True
Range("I6").Select
ActiveSheet.PivotTables("MoviePivot").NullString = "0"

ActiveWorkbook.ShowPivotTableFieldList = False

With ActiveSheet.PivotTables("MoviePivot")
.DisplayErrorString = True
.ErrorString = "0"
.NullString = "0"
End With

End Sub

Sub CreatePivotChartEmbedded()

Dim sh As Shape
Dim s As Series
Dim ws As Worksheet
Dim ch As Chart
Dim pt As PivotTable
Set ws = Worksheets("Query1")
ws.Activate
Set sh = ws.Shapes.AddChart2( _
XlChartType:=XlChartType.xlColumnStacked, _
Width:=2500, Height:=450)

Set ch = sh.Chart

Set pt = ws.PivotTables("MoviePivot")
ch.SetSourceData pt.TableRange2

sh.Top = pt.TableRange2.Top
sh.Left = pt.TableRange2.Left + pt.TableRange2.Width + 10

With ch
.ChartType = xlColumnClustered
.HasLegend = True
.HasTitle = True
.ChartTitle.Text = "Project Wise Defect Aging Report for QA Cycle"
.Axes(xlCategory).HasTitle = True
.Axes(xlCategory).AxisTitle.Text = "Project Name"
.Axes(xlValue).HasTitle = True
.Axes(xlValue).AxisTitle.Text = "Defect Count Age Wise"

For Each s In .SeriesCollection
s.ApplyDataLabels

Next s

ch.SetElement (msoElementDataTableWithLegendKeys)

ch.FullSeriesCollection(1).DataLabels.Select
'Selection.Orientation = xlUpward
'Selection.Format.TextFrame2.Orientation = msoTextOrientationUpward

End With

End Sub

Sub Format_Data()
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With

Selection.EntireColumn.AutoFit
Range("A1:G1").Select
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
End Sub


code for enabling disabling defect fields cont…

Sub Bug_MoveTo
On Error Resume Next

WizardFieldCust_Details ' Added by wizard

if Bug_Fields("BG_STATUS").Value = "Open" then
Bug_Fields("BG_USER_02").IsRequired = True
else
Bug_Fields("BG_USER_02").IsRequired = False
end if

On Error GoTo 0
End Sub

Sub Bug_FieldChange(FieldName)
On Error Resume Next

if FieldName = "BG_STATUS" and Bug_Fields("BG_STATUS").Value = "Open" then
Bug_Fields("BG_USER_02").IsRequired = True
if Bug_Fields("BG_USER_01").Value "" then
Bug_Fields("BG_USER_01").IsVisible = True
Bug_Fields("BG_USER_01").IsReadOnly = True
end if
else
Bug_Fields("BG_USER_02").IsRequired = False
end if

if FieldName = "BG_USER_02" and Bug_Fields("BG_STATUS").Value = "Open" then
Bug_Fields("BG_USER_02").IsReadOnly = True
Bug_Fields("BG_USER_02").IsRequired = True
Bug_Fields("BG_USER_01").IsVisible = True
end if

if FieldName = "BG_USER_01" and Bug_Fields("BG_USER_01").Value "" then
Bug_Fields("BG_USER_01").IsReadOnly= True
Bug_Fields("BG_USER_02").IsReadOnly = True
Bug_Fields("BG_USER_02").IsRequired = True
Bug_Fields("BG_USER_01").IsVisible = True
end if

On Error GoTo 0
End Sub


code for enabling disabling defect fields


Function ActionCanExecute(ActionName)
'Use ActiveModule and ActiveDialogName to get
'the current context.
On Error Resume Next

'Use the following script to redirect this function to the module specific function:
Select Case ActiveModule
Case "Defects"
'ActionCanExecute = Defects_ActionCanExecute(ActionName)
if ActionName = "actBugDetails" or ActionName = "Defects.DefectDetails" then
'WizardFieldCust_Details
if Bug_Fields("BG_STATUS").Value= "Open" then
Bug_Fields("BG_USER_02").IsRequired = True
if Bug_Fields("BG_USER_02").Value = "" then
Bug_Fields("BG_USER_02").IsReadOnly = False
else
Bug_Fields("BG_USER_02").IsReadOnly = True
end if
end if

if Bug_Fields("BG_STATUS").Value "Open" then
if Bug_Fields("BG_USER_02").Value = "" then
Bug_Fields("BG_USER_02").IsReadOnly = False
else
Bug_Fields("BG_USER_02").IsReadOnly = True
if Bug_Fields("BG_USER_01").Value "" then
Bug_Fields("BG_USER_01").IsVisible = True
Bug_Fields("BG_USER_01").IsReadOnly = True
elseif Bug_Fields("BG_USER_01").Value = "" then
Bug_Fields("BG_USER_01").IsVisible = True
Bug_Fields("BG_USER_01").IsReadOnly = False
end if
end if
end if

if Bug_Fields("BG_USER_02").IsReadOnly and Bug_Fields("BG_USER_02").IsRequired and Bug_Fields("BG_USER_02").Value "" then
if Bug_Fields("BG_USER_01").Value "" then
Bug_Fields("BG_USER_01").IsVisible = True
Bug_Fields("BG_USER_01").IsReadOnly = True
elseif Bug_Fields("BG_USER_01").Value = "" then
Bug_Fields("BG_USER_01").IsVisible = True
Bug_Fields("BG_USER_01").IsReadOnly = False
end if
end if

end if
' Case "Test Lab"
' ActionCanExecute = TestLab_ActionCanExecute(ActionName)
' Case "Test Plan"
' ActionCanExecute = TestPlan_ActionCanExecute(ActionName)
' Case "Requirements"
' ActionCanExecute = Requirements_ActionCanExecute(ActionName)
' Case "Management"
' ActionCanExecute = Management_ActionCanExecute(ActionName)
' Case "Test Resources"
' ActionCanExecute = Resources_ActionCanExecute(ActionName)
' Case "Business Components"
' ActionCanExecute = Components_ActionCanExecute(ActionName)
' Case "Dashboard"
' ActionCanExecute = Analysis_ActionCanExecute(ActionName)
' Case "Business Models"
' ActionCanExecute = BusinessModels_ActionCanExecute(ActionName)
' Case "Test Runs"
' ActionCanExecute = TestRuns_ActionCanExecute(ActionName)
End Select
ActionCanExecute = DefaultRes
On Error GoTo 0
End Function


Example for Enabling and Disabling Fields in QC Workflow


Sub Bug_MoveTo
On Error Resume Next
'If the highlighted Defect's Status is Open, make BG_USER_02 Required.
if Bug_Fields("BG_STATUS").Value = "Open" then
Bug_Fields("BG_USER_02").IsRequired = True
if Bug_Fields(BG_USER_02).Value "" Then
Bug_Fields("BG_USER_02").IsReadOnly = True
end if
else
Bug_Fields("BG_USER_02").IsRequired = False
end if
On Error GoTo 0
End Sub

Sub Bug_FieldChange(FieldName)
On Error Resume Next
'If the Defect being modified has a Status of Open, make BG_USER_02 Required.
if Bug_Fields("BG_STATUS").Value = "Open" then
Bug_Fields("BG_USER_02").IsRequired = True ' AFD Required
else
Bug_Fields("BG_USER_02").IsRequired = False ' AFD not Required
end if

if FieldName = "BG_USER_02" and Bug_Fields("BG_STATUS").Value = "Open" then

Dim Result 'As VbMsgBoxResult
Result = MsgBox("Do you want to change the date entered?" _
, vbYesNo _
, "Actual Fix Date Confirmation:" _
)
if Result = 7 then
Bug_Fields("BG_USER_02").IsReadOnly = True
Bug_Fields("BG_USER_01").IsVisible = True
else
Bug_Fields("BG_USER_02").IsReadOnly = False
' Bug_Fields("BG_USER_01").IsVisible = False
end if

end if

On Error GoTo 0
End Sub


How to Create a Pivot Chart From a Pivot Table


Sub CreatePivotTable()

Dim pc As PivotCache
Dim ws As Worksheet
Dim pt As PivotTable
Dim wsMovies As Worksheet

Set wsMovies = ThisWorkbook.Sheets("Overall")

Set pc = ThisWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=wsMovies.Name & "!" & wsMovies.Range("A1").CurrentRegion.Address, _
Version:=xlPivotTableVersion15)

'Set ws = Worksheets.Add
'ws.Name = "MovieTable"
wsMovies.Range("G1").Select

Set pt = pc.CreatePivotTable( _
TableDestination:=ActiveCell, _
TableName:="MoviePivot")

wsMovies.Range("G1").Select

With ActiveSheet.PivotTables("MoviePivot").PivotFields(" Test Set Name")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("MoviePivot").PivotFields("Cycle Name")
.Orientation = xlPageField
.Position = 1
End With
ActiveSheet.PivotTables("MoviePivot").AddDataField ActiveSheet.PivotTables( _
"MoviePivot").PivotFields("Defect Density"), "Count of Defect Density", xlCount
With ActiveSheet.PivotTables("MoviePivot").PivotFields( _
"Count of Defect Density")
.Caption = "Sum of Defect Density"
.Function = xlSum
End With
ActiveWorkbook.ShowPivotTableFieldList = False

pt.DataFields(1).NumberFormat = "0.00"

End Sub

Sub CreatePivotChartEmbedded()

Dim sh As Shape
Dim ws As Worksheet
Dim ch As Chart
Dim pt As PivotTable
Set ws = Worksheets("Overall")
ws.Activate
Delete_Chart_Objects
Set sh = ws.Shapes.AddChart2( _
XlChartType:=XlChartType.xlColumnStacked, _
Width:=1500, Height:=900)

Set ch = sh.Chart

Set pt = ws.PivotTables("MoviePivot")
ch.SetSourceData pt.TableRange2

sh.Top = pt.TableRange2.Top
sh.Left = pt.TableRange2.Left + pt.TableRange2.Width + 10

With ch
.ChartType = xlColumnClustered
.HasLegend = True
.HasTitle = True
.ChartTitle.Text = "Defect Density Chart"
.Axes(xlCategory).HasTitle = True
.Axes(xlCategory).AxisTitle.Text = "Test Set Name"
.Axes(xlValue).HasTitle = True
.Axes(xlValue).AxisTitle.Text = "Quantity"
For Each s In .SeriesCollection
s.ApplyDataLabels
Next s
End With

End Sub


How to add a Chart Object to a worksheet

Sub InsertChart_Inside_Worksheet()
Dim My_Work_Sheet As Worksheet
Dim Film_Range As Range
Dim Nominations_Range As Range
Dim Chart_Range As Range
Dim Ch As Shape
Dim Co As ChartObject
Dim s As Series
Set My_Work_Sheet = ThisWorkbook.Sheets("Sheet1")
My_Work_Sheet.Activate
My_Work_Sheet.Range("A1").Select
Set Film_Range = Range("A1", Range("A1").End(xlDown))
Set Nominations_Range = Range("D1", Range("D1").End(xlDown))
Set Chart_Range = Union(Film_Range, _
Nominations_Range)
Chart_Range.Select
Delete_Chart_Objects
Set Ch = My_Work_Sheet.Shapes.AddChart(XlChartType.xlColumnClustered, 250, 30, 450, 300)
Ch.Chart.SetSourceData Chart_Range
With Ch.Chart
.ChartType = xlColumnClustered
.HasLegend = True
.HasTitle = True
.ChartTitle.Text = "Defect Density Chart"
.Axes(xlCategory).HasTitle = True
.Axes(xlCategory).AxisTitle.Text = "Test Set Name"
.Axes(xlValue).HasTitle = True
.Axes(xlValue).AxisTitle.Text = "Quantity"
For Each s In .SeriesCollection
s.ApplyDataLabels
Next s
End With
End Sub

Sample Code to Create a Chart from Excel Data

Sub CreateChart()

Dim My_Work_Sheet As Worksheet
Dim Film_Range As Range
Dim Nominations_Range As Range
Dim Chart_Range As Range
Dim Ch As Chart
Dim s As Series

Set My_Work_Sheet = ThisWorkbook.Sheets(“Sheet1”)
My_Work_Sheet.Activate
My_Work_Sheet.Range(“A1”).Select
‘ Charts.Add

Set Film_Range = Range(“A1”, Range(“A1”).End(xlDown))
Set Nominations_Range = Range(“D1”, Range(“D1”).End(xlDown))
Set Chart_Range = Union(Film_Range, _
Nominations_Range)

Chart_Range.Select
Set Ch = Charts.Add
‘ Set Ch = Charts.Add2
‘ Charts.Add Before:=My_Work_Sheet
Ch.SetSourceData Chart_Range
‘ Ch.ChartWizard Source:=Chart_Range
‘ Ch.ChartType = xl3DLine

Ch.Move After:=Sheets(Sheets.Count)
Ch.Name = “Defect Density Chart”
Ch.HasLegend = True
Ch.HasTitle = True
Ch.ChartTitle.Text = “Defect Density Chart”

Ch.Axes(xlCategory).HasTitle = True
Ch.Axes(xlCategory).AxisTitle.Text = “Test Set Name”

Ch.Axes(xlValue).HasTitle = True
Ch.Axes(xlValue).AxisTitle.Text = “Quantity”

For Each s In Ch.SeriesCollection
s.ApplyDataLabels
Next s

End Sub