Hi ,
I am getting the same run time error 2147024809-80070057 , when I execute the below macro . Please help . Red highlighted line is where the program stops with above specified error.
Sub Button1_Click()
'Procedure to set the Arc Percentages and the Textbox values
'Setting values and color for the Arc and Textbox object in the Dashboard sheet
With Worksheets("Dashboard")
SetArcPercentage .Shapes("ArcOverall"), Sheet5.Range("D5").Value
.Shapes("TBOverall").TextFrame.Characters.Text = Round(Sheet5.Range("D5").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBOverall"), .Shapes("ArcOverall"), Sheet5.Range("D5").Value
SetArcPercentage .Shapes("ArcOMNI"), Sheet5.Range("D23").Value
.Shapes("TBOMNI").TextFrame.Characters.Text = Round(Sheet5.Range("D23").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBOMNI"), .Shapes("ArcOMNI"), Sheet5.Range("D23").Value
SetArcPercentage .Shapes("ArcWSC"), Sheet5.Range("D15").Value
.Shapes("TBWSC").TextFrame.Characters.Text = Round(Sheet5.Range("D15").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBWSC"), .Shapes("ArcWSC"), Sheet5.Range("D15").Value
SetArcPercentage .Shapes("ArcAMES"), Sheet5.Range("D7").Value
.Shapes("TBAMES").TextFrame.Characters.Text = Round(Sheet5.Range("D7").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAMES"), .Shapes("ArcAMES"), Sheet5.Range("D7").Value
SetArcPercentage .Shapes("ArcAuto"), Sheet5.Range("D31").Value
.Shapes("TBAUTO").TextFrame.Characters.Text = Round(Sheet5.Range("D31").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAUTO"), .Shapes("ArcAuto"), Sheet5.Range("D31").Value
SetArcPercentage .Shapes("ArcSQL"), Sheet5.Range("D39").Value
.Shapes("TBSQL").TextFrame.Characters.Text = Round(Sheet5.Range("D39").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBSQL"), .Shapes("ArcSQL"), Sheet5.Range("D39").Value
SetArcPercentage .Shapes("ArcDOT"), Sheet5.Range("D47").Value
.Shapes("TBDOT").TextFrame.Characters.Text = Round(Sheet5.Range("D47").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBDOT"), .Shapes("ArcDOT"), Sheet5.Range("D47").Value
End With
'Setting values and color for the Arc and Textbox object in the OMNI sheet
With Worksheets("QA")
SetArcPercentage .Shapes("ArcOMNIDoc"), Sheet5.Range("D8").Value
.Shapes("TBOMNIDoc").TextFrame.Characters.Text = Round(Sheet5.Range("D8").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBOMNIDoc"), .Shapes("ArcOMNIDoc"), Sheet5.Range("D8").Value
SetArcPercentage .Shapes("ArcOMNIAppAndEnv"), Sheet5.Range("D9").Value
.Shapes("TBOMNIAppAndEnv").TextFrame.Characters.Text = Round(Sheet5.Range("D9").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBOMNIAppAndEnv"), .Shapes("ArcOMNIAppAndEnv"), Sheet5.Range("D9").Value
SetArcPercentage .Shapes("ArcOMNIProcess"), Sheet5.Range("D10").Value
.Shapes("TBOMNIProcess").TextFrame.Characters.Text = Round(Sheet5.Range("D10").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBOMNIProcess"), .Shapes("ArcOMNIProcess"), Sheet5.Range("D10").Value
SetArcPercentage .Shapes("ArcOMNITech"), Sheet5.Range("D11").Value
.Shapes("TBOMNITech").TextFrame.Characters.Text = Round(Sheet5.Range("D11").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBOMNITech"), .Shapes("ArcOMNITech"), Sheet5.Range("D11").Value
SetArcPercentage .Shapes("ArcOMNIBusiness"), Sheet5.Range("D12").Value
.Shapes("TBOMNIBusiness").TextFrame.Characters.Text = Round(Sheet5.Range("D12").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBOMNIBusiness"), .Shapes("ArcOMNIBusiness"), Sheet5.Range("D12").Value
SetArcPercentage .Shapes("ArcOMNITeam"), Sheet5.Range("D13").Value
.Shapes("TBOMNITeam").TextFrame.Characters.Text = Round(Sheet5.Range("D13").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBOMNITeam"), .Shapes("ArcOMNITeam"), Sheet5.Range("D13").Value
End With
'Setting values and color for the Arc and Textbox object in the AMES sheet
With Worksheets("PeopleSoft")
SetArcPercentage .Shapes("ArcAMESDoc"), Sheet5.Range("D24").Value
.Shapes("TBAMESDoc").TextFrame.Characters.Text = Round(Sheet5.Range("D24").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAMESDoc"), .Shapes("ArcAMESDoc"), Sheet5.Range("D24").Value
SetArcPercentage .Shapes("ArcAMESAppAndEnv"), Sheet5.Range("D25").Value
.Shapes("TBAMESAppAndEnv").TextFrame.Characters.Text = Round(Sheet5.Range("D25").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAMESAppAndEnv"), .Shapes("ArcAMESAppAndEnv"), Sheet5.Range("D25").Value
SetArcPercentage .Shapes("ArcAMESProcess"), Sheet5.Range("D26").Value
.Shapes("TBAMESProcess").TextFrame.Characters.Text = Round(Sheet5.Range("D26").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAMESProcess"), .Shapes("ArcAMESProcess"), Sheet5.Range("D26").Value
SetArcPercentage .Shapes("ArcAMESTech"), Sheet5.Range("D27").Value
.Shapes("TBAMESTech").TextFrame.Characters.Text = Round(Sheet5.Range("D27").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAMESTech"), .Shapes("ArcAMESTech"), Sheet5.Range("D27").Value
SetArcPercentage .Shapes("ArcAMESBusiness"), Sheet5.Range("D28").Value
.Shapes("TBAMESBusiness").TextFrame.Characters.Text = Round(Sheet5.Range("D28").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAMESBusiness"), .Shapes("ArcAMESBusiness"), Sheet5.Range("D28").Value
SetArcPercentage .Shapes("ArcAMESTeam"), Sheet5.Range("D29").Value
.Shapes("TBAMESTeam").TextFrame.Characters.Text = Round(Sheet5.Range("D29").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAMESTeam"), .Shapes("ArcAMESTeam"), Sheet5.Range("D29").Value
End With
'Setting values and color for the Arc and Textbox object in the WSC sheet
With Worksheets("TIBCO")
SetArcPercentage .Shapes("ArcWSCDoc"), Sheet5.Range("D16").Value
.Shapes("TBWSCDOC").TextFrame.Characters.Text = Round(Sheet5.Range("D16").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBWSCDOC"), .Shapes("ArcWSCDoc"), Sheet5.Range("D16").Value
SetArcPercentage .Shapes("ArcWSCAppAndEnv"), Sheet5.Range("D17").Value
.Shapes("TBWSCAppAndEnv").TextFrame.Characters.Text = Round(Sheet5.Range("D17").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBWSCAppAndEnv"), .Shapes("ArcWSCAppAndEnv"), Sheet5.Range("D17").Value
SetArcPercentage .Shapes("ArcWSCProcess"), Sheet5.Range("D18").Value
.Shapes("TBWSCProcess").TextFrame.Characters.Text = Round(Sheet5.Range("D18").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBWSCProcess"), .Shapes("ArcWSCProcess"), Sheet5.Range("D18").Value
SetArcPercentage .Shapes("ArcWSCTech"), Sheet5.Range("D19").Value
.Shapes("TBWSCTech").TextFrame.Characters.Text = Round(Sheet5.Range("D19").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBWSCTech"), .Shapes("ArcWSCTech"), Sheet5.Range("D19").Value
SetArcPercentage .Shapes("ArcWSCBusiness"), Sheet5.Range("D20").Value
.Shapes("TBWSCBusiness").TextFrame.Characters.Text = Round(Sheet5.Range("D20").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBWSCBusiness"), .Shapes("ArcWSCBusiness"), Sheet5.Range("D20").Value
SetArcPercentage .Shapes("ArcWSCTeam"), Sheet5.Range("D21").Value
.Shapes("TBWSCTeam").TextFrame.Characters.Text = Round(Sheet5.Range("D21").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBWSCTeam"), .Shapes("ArcWSCTeam"), Sheet5.Range("D21").Value
End With
'Setting values and color for the Arc and Textbox object in the Automation sheet
With Worksheets("HYPERION")
SetArcPercentage .Shapes("ArcAUTODoc"), Sheet5.Range("D32").Value
.Shapes("TBAUTODOC").TextFrame.Characters.Text = Round(Sheet5.Range("D32").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAUTODOC"), .Shapes("ArcAUTODoc"), Sheet5.Range("D32").Value
SetArcPercentage .Shapes("ArcAUTOAppAndEnv"), Sheet5.Range("D33").Value
.Shapes("TBAUTOAppAndEnv").TextFrame.Characters.Text = Round(Sheet5.Range("D33").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAUTOAppAndEnv"), .Shapes("ArcAUTOAppAndEnv"), Sheet5.Range("D33").Value
SetArcPercentage .Shapes("ArcAUTOProcess"), Sheet5.Range("D34").Value
.Shapes("TBAUTOProcess").TextFrame.Characters.Text = Round(Sheet5.Range("D34").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAUTOProcess"), .Shapes("ArcAUTOProcess"), Sheet5.Range("D34").Value
SetArcPercentage .Shapes("ArcAUTOTech"), Sheet5.Range("D35").Value
.Shapes("TBAUTOTech").TextFrame.Characters.Text = Round(Sheet5.Range("D35").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAUTOTech"), .Shapes("ArcAUTOTech"), Sheet5.Range("D35").Value
SetArcPercentage .Shapes("ArcAUTOBusiness"), Sheet5.Range("D36").Value
.Shapes("TBAUTOBusiness").TextFrame.Characters.Text = Round(Sheet5.Range("D36").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAUTOBusiness"), .Shapes("ArcAUTOBusiness"), Sheet5.Range("D36").Value
SetArcPercentage .Shapes("ArcAUTOTeam"), Sheet5.Range("D37").Value
.Shapes("TBAUTOTeam").TextFrame.Characters.Text = Round(Sheet5.Range("D37").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBAUTOTeam"), .Shapes("ArcAUTOTeam"), Sheet5.Range("D37").Value
End With
'Begin : Added by Jaikumar SK----
With Worksheets("SQLDBA")
SetArcPercentage .Shapes("ArcSQLDoc"), Sheet5.Range("D40").Value
.Shapes("TBSQLDOC").TextFrame.Characters.Text = Round(Sheet5.Range("D40").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBSQLDOC"), .Shapes("ArcSQLDoc"), Sheet5.Range("D40").Value
SetArcPercentage .Shapes("ArcSQLAppAndEnv"), Sheet5.Range("D41").Value
.Shapes("TBSQLAppAndEnv").TextFrame.Characters.Text = Round(Sheet5.Range("D41").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBSQLAppAndEnv"), .Shapes("ArcSQLAppAndEnv"), Sheet5.Range("D41").Value
SetArcPercentage .Shapes("ArcSQLProcess"), Sheet5.Range("D42").Value
.Shapes("TBSQLProcess").TextFrame.Characters.Text = Round(Sheet5.Range("D42").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBSQLProcess"), .Shapes("ArcSQLProcess"), Sheet5.Range("D42").Value
SetArcPercentage .Shapes("ArcSQLTech"), Sheet5.Range("D43").Value
.Shapes("TBSQLTech").TextFrame.Characters.Text = Round(Sheet5.Range("D43").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBSQLTech"), .Shapes("ArcSQLTech"), Sheet5.Range("D43").Value
SetArcPercentage .Shapes("ArcSQLBusiness"), Sheet5.Range("D44").Value
.Shapes("TBSQLBusiness").TextFrame.Characters.Text = Round(Sheet5.Range("D44").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBSQLBusiness"), .Shapes("ArcSQLBusiness"), Sheet5.Range("D44").Value
SetArcPercentage .Shapes("ArcSQLTeam"), Sheet5.Range("D45").Value
.Shapes("TBSQLTeam").TextFrame.Characters.Text = Round(Sheet5.Range("D45").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBSQLTeam"), .Shapes("ArcSQLTeam"), Sheet5.Range("D45").Value
End With
With Worksheets(".NET")
SetArcPercentage .Shapes("ArcDOTDoc"), Sheet5.Range("D48").Value
.Shapes("TBDOTDOC").TextFrame.Characters.Text = Round(Sheet5.Range("D48").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBDOTDOC"), .Shapes("ArcDOTDoc"), Sheet5.Range("D48").Value
SetArcPercentage .Shapes("ArcDOTAppAndEnv"), Sheet5.Range("D49").Value
.Shapes("TBDOTAppAndEnv").TextFrame.Characters.Text = Round(Sheet5.Range("D49").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBDOTAppAndEnv"), .Shapes("ArcDOTAppAndEnv"), Sheet5.Range("D49").Value
SetArcPercentage .Shapes("ArcDOTProcess"), Sheet5.Range("D50").Value
.Shapes("TBDOTProcess").TextFrame.Characters.Text = Round(Sheet5.Range("D50").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBDOTProcess"), .Shapes("ArcDOTProcess"), Sheet5.Range("D50").Value
SetArcPercentage .Shapes("ArcDOTTech"), Sheet5.Range("D51").Value
.Shapes("TBDOTTech").TextFrame.Characters.Text = Round(Sheet5.Range("D51").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBDOTTech"), .Shapes("ArcDOTTech"), Sheet5.Range("D51").Value
SetArcPercentage .Shapes("ArcDOTBusiness"), Sheet5.Range("D52").Value
.Shapes("TBDOTBusiness").TextFrame.Characters.Text = Round(Sheet5.Range("D52").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBDOTBusiness"), .Shapes("ArcDOTBusiness"), Sheet5.Range("D52").Value
SetArcPercentage .Shapes("ArcDOTTeam"), Sheet5.Range("D53").Value
.Shapes("TBDOTTeam").TextFrame.Characters.Text = Round(Sheet5.Range("D53").Value, 0) & "%"
SetTextAndArcColor .Shapes("TBDOTTeam"), .Shapes("ArcDOTTeam"), Sheet5.Range("D53").Value
End With
End Sub
Private Sub SetArcPercentage(objArc As Shape, Percentage As Integer)
' Procedure to set the angle of the passed arc as per the percentage passed
' Formula ==== 180 degrees = 100 % then x percentage = ? angle
' Formula ==== angle = 180 x percentage passed / 100
' But excel angle in negative so formula will become
' Formula ==== angle = (-180 x (100-percentages passed)) / 100
Dim intArcAngle As Integer
'Handle the 0% - 0 value will set the arc angle to 360 which we do not want!
If Percentage <> 0 Then
intArcAngle = (-180 * (100 - Percentage)) / 100
Else
intArcAngle = -175
End If
objArc.Adjustments.Item(2) = intArcAngle
End Sub
Private Function GetCurrentWeekTargetPercentage() As Integer
'A function to retrive the current week value ans based on that
'retrive the target percentage for setting the color of the percentage values
'Code uses named ranges (cells) in the Input work sheet
Select Case Range("I5").Value
Case 1 'Week 1
GetCurrentWeekTargetPercentage = Range("H18").Value
Case 2 'Week 2
GetCurrentWeekTargetPercentage = Range("H19").Value
Case 3 'Week 3
GetCurrentWeekTargetPercentage = Range("H20").Value
Case 4 'Week 4
GetCurrentWeekTargetPercentage = Range("H21").Value
Case 5 'Week 5
GetCurrentWeekTargetPercentage = Range("H22").Value
Case 6 'Week 6
GetCurrentWeekTargetPercentage = Range("H23").Value
Case Else 'Error - Return 0
GetCurrentWeekTargetPercentage = 0
End Select
End Function
Private Function GetCurrentWeekYellowPercentage() As Integer
'A function to retrive the current week Yellow value
'Code uses named ranges (cells) in the Input work sheet
Select Case Range("I5").Value
Case 1 'Week 1
GetCurrentWeekYellowPercentage = Range("I18").Value
Case 2 'Week 2
GetCurrentWeekYellowPercentage = Range("I19").Value
Case 3 'Week 3
GetCurrentWeekYellowPercentage = Range("I20").Value
Case 4 'Week 4
GetCurrentWeekYellowPercentage = Range("I21").Value
Case 5 'Week 5
GetCurrentWeekYellowPercentage = Range("I22").Value
Case 6 'Week 6
GetCurrentWeekYellowPercentage = Range("I23").Value
Case Else 'Error - Return 0
GetCurrentWeekYellowPercentage = 0
End Select
End Function
Private Sub SetTextAndArcColor(objTextBox As Shape, objArc As Shape, Percentage As Integer)
'Procedure to set the text color of the percentage text boxes according to the value
'Calls the GetCurrentWeekTargetPercentage for comparing the incoming percentage
'Get the percentage deviation value from the named cell
Dim intTargetPercentage As Integer
intTargetPercentage = GetCurrentWeekTargetPercentage
'First check whether the percenatge is more than the target
'Then set the color to green and exit the sube
If Percentage > intTargetPercentage Then
objTextBox.TextFrame.Characters.Font.Color = vbGreen
objArc.Line.ForeColor.RGB = vbGreen
Exit Sub
End If
'If the percentage is less than the target percetnage
'Then calculate the deviation first
Dim intYellowPercentage As Integer
intYellowPercentage = GetCurrentWeekYellowPercentage
'If the deviation is not within the limits then the color is red
If Percentage < intYellowPercentage Then
objTextBox.TextFrame.Characters.Font.Color = vbRed
objArc.Line.ForeColor.RGB = vbRed
Else 'Else it is within the limits then the color is yellow
objTextBox.TextFrame.Characters.Font.Color = vbYellow
objArc.Line.ForeColor.RGB = vbYellow
End If
End Sub
Regards,
JK