VBABEGINER
Well-known Member
- Joined
- Jun 15, 2011
- Messages
- 1,284
- Office Version
- 365
- Platform
- Windows
Good Evening All,
Hi, from last 3 hours i spend for this coding, but I got Error -
Type MisMatch
"VBAProject.ThisWorkbook.EndReport"
This is the problem. I didnt understand, y this is getting.
Following is the long code, I really thankful those reading this code, b'coz its too long.
But, certainly i am looking for a great help, and that is from U Experts !!
Hi, from last 3 hours i spend for this coding, but I got Error -
Type MisMatch
"VBAProject.ThisWorkbook.EndReport"
This is the problem. I didnt understand, y this is getting.
Following is the long code, I really thankful those reading this code, b'coz its too long.
But, certainly i am looking for a great help, and that is from U Experts !!
Option Explicit
' I created function named "FindnCalculate" for i create this variable globaly
Dim dConActive As Double
Dim dConReactive As Double
Dim dIntActive As Double
Dim dIntReactive As Double
Dim dStdActive As Double
Dim dStdReactive As Double
Dim dSpareActive As Double
Dim dSpareReactive As Double
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'There variables should NOT be modified, removed or renamed
Public SPReport As Object
Private m_objXLAgent As Object
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'User defined variables
Private Const SPReport_Sheet1 As String = "template"
Private Const SPReport_Sheet2 As String = "Sheet2"
Private Const sNormalLoad As String = "Total compensated load for normal operation:"
Private Const sPeakLoad As String = "Total compensated load for peak operation:"
Private m_eCompensatedUnCompensated As CompensatedUncompensated
Private m_eRatedConsumed As RatedConsumed
Private m_bIncludeConverting As Boolean
Private m_objLastSheet As Worksheet
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'These subs or function should NOT be modified, removed or renamed
Private Sub Workbook_Deactivate()
On Error Resume Next
ThisWorkbook.Application.CommandBars("SmartPlant Reports").Enabled = False
End Sub
Public Sub BeginReport(vParam As Variant)
On Error Resume Next
Set m_objXLAgent = vParam
Sheets("template").Visible = xlSheetVisible
End Sub
Public Sub FinalReport(vParam As Variant)
On Error Resume Next
Sheets("template").Visible = xlSheetVeryHidden
End Sub
Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
On Error Resume Next
If SPReport Is Nothing Then
ThisWorkbook.Application.CommandBars("SmartPlant Reports").Enabled = False
Exit Sub
End If
If (SPReport.ExecuteOrDefineFlag <> "Define") Then
ThisWorkbook.Application.CommandBars("SmartPlant Reports").Enabled = False
Exit Sub
Else
ThisWorkbook.Application.CommandBars("SmartPlant Reports").Enabled = True
End If
ThisWorkbook.SPReport.InitializeReport
End Sub
Public Sub ReleaseReference()
Set SPReport = Nothing
End Sub
Public Sub GetSPReportSheets(sSheet1 As String, sSheet2 As String)
sSheet1 = SPReport_Sheet1
sSheet2 = SPReport_Sheet2
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'This is your entry point to cutomize the report. You may change the content of the sub
'But you may not remove, rename or add parameters to it.
Public Sub EndReport()
Dim objPlantTree As IPlantItemsTree
Dim colData As Collection
Dim objPlantItem As IElectricalPlantItem
Dim colSelectedSPIDs As Collection
Dim Res As Long
Const ERR_SOURCE As String = "VBAProject.ThisWorkbook.EndReport"
On Error GoTo EH:
Dim i As Integer
'retrieve the data through SPELXL.
'The process may take a while, disable the alerts
Me.Application.DisplayAlerts = False
'The m_objXLAgent is the object that is used to initialy read a tree.
' objPlantTree - The calculation tree
' colData - collection of additional data
' 3rd parameters - if to show the customize report dialog box.
Res = m_objXLAgent.RunLoadCalculation(objPlantTree, colData, True)
Me.Application.DisplayAlerts = True
If (Res = 0) And (Not objPlantTree Is Nothing) Then
If objPlantTree.RootItems.count > 0 Then
m_eCompensatedUnCompensated = colData("CompensatedUncompensated")
m_eRatedConsumed = colData("RatedConsumed")
m_bIncludeConverting = colData("IncludeConverting")
Set colSelectedSPIDs = colData("SelectedSPIDs")
'Fill the data in the book.
For Each objPlantItem In objPlantTree.RootItems
If IsStringInCol(colSelectedSPIDs, objPlantItem.SPID) Then
If FillData(objPlantItem, colData) <> 0 Then
MsgBox "Error fillup the data."
End If
'sheet setting
ActiveSheet.Columns("AA:IV").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Cells(8, 1).Activate
End If
Next
End If
Else
If Res <> 0 Then
MsgBox "Error Calculating"
End If
End If
ExitSub:
Set objPlantTree = Nothing
Set colData = Nothing
Set colSelectedSPIDs = Nothing
Set objPlantItem = Nothing
Exit Sub
EH:
MsgBox Err.Description & vbCrLf & ERR_SOURCE, vbInformation, "All feeder load summary"
Resume ExitSub
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'These are the user defined subs and functions, you may make changes here
Public Function FillData(ByVal objPlantItem As IElectricalPlantItem, colData As Collection) As Long
Dim lRes As Long
Select Case objPlantItem.ItemType
Case ePowerDistributionBoardItem
lRes = FillPDB(objPlantItem.ToPowerDistributionBoard)
With Sheets(objPlantItem.ItemTag)
.Cells(3, 2).Value = colData("CalcMode")
.Cells(4, 2).Value = colData("Coupling")
.Cells(5, 2).Value = colData("Losses")
.Cells(7, [col_loadcontinuouskw].Column).Value = colData("ReportType")
End With 'Sheets("template")
Case eBusItem
lRes = FillBus(objPlantItem.ToBus, Nothing, 0, True)
End Select
FillData = lRes
End Function
Public Function GetNewSheet() As Worksheet
Dim ws As Worksheet
If m_objLastSheet Is Nothing Then
Sheets("template").Copy before:=Sheets(1)
Set ws = Sheets(1)
Else
Sheets("template").Copy after:=m_objLastSheet
Set ws = Sheets(m_objLastSheet.Index + 1)
End If
Set m_objLastSheet = ws
Set GetNewSheet = ws
End Function
Private Function FillPDB(udPDB As IPowerDistributionBoard) As Long
Dim ws As Worksheet
Dim udBus As IBus
Dim udTotals As ICalculatedLoads
Dim lFirstRow As Long
Dim lRowCounter As Long
Dim lRes As Long
Set ws = GetNewSheet
If udPDB.ToIElectricalPlantItem.ItemTag <> "" Then
ws.Name = udPDB.ToIElectricalPlantItem.ItemTag
End If
lFirstRow = Sheets("SPReport_Definition").Cells(2, 1) + 2
lRowCounter = lFirstRow
With ws
.Cells(1, 2).Value = udPDB.ToIElectricalPlantItem.ItemTag
For Each udBus In udPDB.Buses
lRes = FillBus(udBus, ws, lRowCounter, False)
lRowCounter = lRowCounter + 1
Next
Set udTotals = SelectCompensatedTotals(udPDB)
lRowCounter = lRowCounter + 3
.Cells(lRowCounter, 1) = "PDB Totals:"
With .Range(.Cells(lRowCounter, 1), .Cells(lRowCounter, cLastColumn))
.Merge
.HorizontalAlignment = xlCenter
With .Interior
.ColorIndex = 15
.Pattern = xlSolid
End With 'Interior
End With
.Cells(lRowCounter + 2, 1) = sNormalLoad
.Cells(lRowCounter + 2, 1).Font.Bold = True
.Cells(lRowCounter + 2, 1).WrapText = False
.Cells(lRowCounter + 3, 1) = Round(udTotals.RunActive, 3) & " kW"
.Cells(lRowCounter + 4, 1) = Round(udTotals.RunReactive, 3) & " kVAR"
.Cells(lRowCounter + 5, 1) = Round(udTotals.RunApparent, 3) & " kVA"
.Cells(lRowCounter + 6, 1) = "Power factor: " & Round(udTotals.RunPowerFactor, 3)
.Cells(lRowCounter + 8, 1) = sPeakLoad
.Cells(lRowCounter + 8, 1).Font.Bold = True
.Cells(lRowCounter + 8, 1).WrapText = False
.Cells(lRowCounter + 9, 1) = Round(udTotals.PeakActive, 3) & " kW"
.Cells(lRowCounter + 10, 1) = Round(udTotals.PeakReactive, 3) & " kVAR"
.Cells(lRowCounter + 11, 1) = Round(udTotals.PeakApparent, 3) & " kVA"
.Cells(lRowCounter + 12, 1) = "Power factor: " & Round(udTotals.PeakPowerFactor, 3)
End With 'ws
Set ws = Nothing
Set udTotals = Nothing
Call FindnCalculate
End Function
Private Function FillConvertingEquipment(ByVal udConvertingEquipment As IConvertingEquipment, ws As Worksheet, lRowCounter As Long) As Long
With ws
.Cells(lRowCounter, [col_LoadName].Column) = udConvertingEquipment.ToIElectricalPlantItem.ItemTag & " losses"
.Cells(lRowCounter, [col_itemtype].Column) = udConvertingEquipment.ToIElectricalPlantItem.ItemTypeName
.Cells(lRowCounter, [col_description].Column) = udConvertingEquipment.ToIElectricalPlantItem.Description
.Cells(lRowCounter, [col_remarks].Column) = udConvertingEquipment.ToIElectricalPlantItem.Notes
.Cells(lRowCounter, [col_loadcontinuouskw].Column) = udConvertingEquipment.ToIElectricalPlantItem.PropertyValue("SP_ResistiveLosses")
.Cells(lRowCounter, [col_loadcontinuouskvar].Column) = udConvertingEquipment.ToIElectricalPlantItem.PropertyValue("SP_ReactiveLosses")
End With
End Function
Private Function FillLoad(ByVal udLoad As ILoad, ws As Worksheet, lRowCounter As Long) As Long
Dim objTotals As ICalculatedLoads
Set objTotals = SelectTotals(udLoad)
With ws
.Cells(lRowCounter, [col_LoadName].Column) = udLoad.ToIElectricalPlantItem.ItemTag
.Cells(lRowCounter, [col_itemtype].Column) = udLoad.ToIElectricalPlantItem.ItemTypeName
.Cells(lRowCounter, [col_description].Column) = udLoad.ToIElectricalPlantItem.Description
If udLoad.ToIElectricalPlantItem.IsPropertyExist("BrakePower") Then
.Cells(lRowCounter, [col_brakepower].Column) = udLoad.ToIElectricalPlantItem.PropertyValue("BrakePower")
End If
FillLoadRatedPower udLoad, ws, lRowCounter
If udLoad.ToIElectricalPlantItem.IsPropertyExist("DemandFactor") Then
.Cells(lRowCounter, [col_demandfactor].Column) = udLoad.ToIElectricalPlantItem.PropertyValue("DemandFactor")
End If
If udLoad.ToIElectricalPlantItem.IsPropertyExist("EfficiencyOperating") Then
.Cells(lRowCounter, [col_effdemand].Column) = udLoad.ToIElectricalPlantItem.PropertyValue("EfficiencyOperating")
End If
If udLoad.ToIElectricalPlantItem.IsPropertyExist("PowerFactorOperating") Then
.Cells(lRowCounter, [col_pfdemand].Column) = udLoad.ToIElectricalPlantItem.PropertyValue("PowerFactorOperating")
End If
.Cells(lRowCounter, [col_xcoincidence].Column) = udLoad.XCoincidenceFactor
.Cells(lRowCounter, [col_ycoincidence].Column) = udLoad.YCoincidenceFactor
.Cells(lRowCounter, [col_zcoincidence].Column) = udLoad.ZCoincidenceFactor
.Cells(lRowCounter, [col_zzcoincidence].Column) = udLoad.ZZCoincidenceFactor
.Cells(lRowCounter, [col_remarks].Column) = udLoad.ToIElectricalPlantItem.Notes
Select Case udLoad.OperatingMode
Case enmOperatingMode.eContinuous
.Cells(lRowCounter, [col_loadcontinuouskw].Column) = objTotals.ContinuousActive
.Cells(lRowCounter, [col_loadcontinuouskvar].Column) = objTotals.ContinuousReactive
Case enmOperatingMode.eIntermittent
.Cells(lRowCounter, [col_loadintermittentkw].Column) = objTotals.IntermittentActive
.Cells(lRowCounter, [col_loadintermittentkvar].Column) = objTotals.IntermittentReactive
Case enmOperatingMode.eStandby
.Cells(lRowCounter, [col_loadstandbykw].Column) = objTotals.StandbyActive
.Cells(lRowCounter, [col_loadstandbykvar].Column) = objTotals.StandbyReactive
Case enmOperatingMode.eSpare
.Cells(lRowCounter, [col_loadsparekw].Column) = objTotals.SpareActive
.Cells(lRowCounter, [col_loadsparekvar].Column) = objTotals.SpareReactive
End Select
.Range(.Cells(lRowCounter, [col_brakepower].Column), .Cells(lRowCounter, cLastColumn)).HorizontalAlignment = xlCenter
End With
End Function
Private Sub FillLoadRatedPower(objLoadItem As ILoad, ws As Worksheet, lRow As Long)
'The power rated power field name vary from load to load.
Dim sFieldName As String
Select Case UCase$(objLoadItem.ToIElectricalPlantItem.ItemTypeName)
Case "MOTOR"
sFieldName = "MotorRatedPower"
Case "HEATER"
sFieldName = "HeaterRatedPower"
Case "HEATTRACE"
sFieldName = "HeatTraceRatedPower"
Case "CAPACITOR"
sFieldName = "CapacitorRatedPower"
Case "HARMONICFILTER"
sFieldName = "HarmonicFilterRatedPower"
Case "OTHERELECTEQUIPMENT"
sFieldName = "OtherEquipRatedPower"
Case "RESISTOR"
sFieldName = "ResistorRatedPower"
'Note that in the calculation module, cabinets and instruments considered as loads, as they consumers
Case "CABINET"
sFieldName = "CabinetRatedPower"
Case "INSTRUMENT"
sFieldName = "InstrumentRatedPower"
End Select
If Len(sFieldName) > 0 Then
ws.Cells(lRow, [col_ratedpower].Column) = objLoadItem.ToIElectricalPlantItem.PropertyValue(sFieldName) & ""
End If
End Sub
Private Function FillCircuit(ByVal udCircuit As ICircuit, ws As Worksheet, lRowCounter As Long) As Long
Dim oTotal As ICalculatedLoads
Set oTotal = SelectTotals(udCircuit)
With ws
.Cells(lRowCounter, [col_LoadName].Column) = udCircuit.ToIElectricalPlantItem.ItemTag
.Cells(lRowCounter, [col_itemtype].Column) = udCircuit.ToIElectricalPlantItem.PropertyValue("CircuitType") & ""
.Cells(lRowCounter, [col_description].Column) = udCircuit.ToIElectricalPlantItem.Description
.Cells(lRowCounter, [col_loadcontinuouskw].Column) = oTotal.ContinuousActive '& " kW"
.Cells(lRowCounter, [col_loadcontinuouskvar].Column) = oTotal.ContinuousReactive '& " kVar"
.Cells(lRowCounter, [col_loadintermittentkw].Column) = oTotal.IntermittentActive '& " kW"
.Cells(lRowCounter, [col_loadintermittentkvar].Column) = oTotal.IntermittentReactive ' & " kVar"
.Cells(lRowCounter, [col_loadstandbykw].Column) = oTotal.StandbyActive '& " kW"
.Cells(lRowCounter, [col_loadstandbykvar].Column) = oTotal.StandbyReactive '& " kVar"
.Cells(lRowCounter, [col_loadsparekw].Column) = oTotal.SpareActive '& " kW"
.Cells(lRowCounter, [col_loadsparekvar].Column) = oTotal.SpareReactive '& " kVar"
.Cells(lRowCounter, [col_remarks].Column) = udCircuit.ToIElectricalPlantItem.Notes
.Range(.Cells(lRowCounter, [col_loadcontinuouskw].Column), .Cells(lRowCounter, cLastColumn)).HorizontalAlignment = xlCenter
lRowCounter = lRowCounter + 1
End With
End Function
Private Function FillBus(ByVal udBus As IBus, ws As Worksheet, lRowCounter As Long, bNewSheet As Boolean) As Long
Dim udCircuit As ICircuit
Dim udTotals As ICalculatedLoads
Dim udLoad As ILoad
Dim cOtherCircuits As Collection
Dim udConvertingEquipment As IConvertingEquipment
Dim colConvs As IConvertingEquipments
Dim dConActive As Double
Dim dConReactive As Double
Dim dIntActive As Double
Dim dIntReactive As Double
Dim dStdActive As Double
Dim dStdReactive As Double
Dim dSpareActive As Double
Dim dSpareReactive As Double
Dim objColCircuits As IElectricalPlantItems
Dim objColLoads As ILoads
Dim lFirstRow As Long
Dim bAddLoad As Boolean
If bNewSheet Then
Set ws = GetNewSheet
If udBus.ToIElectricalPlantItem.ItemTag <> "" Then
ws.Name = udBus.ToIElectricalPlantItem.ItemTag
End If
lFirstRow = Sheets("SPReport_Definition").Cells(2, 1) + 2
lRowCounter = lFirstRow
End If
With ws
If udBus.DrillDownEnable Then
.Cells(lRowCounter, 1) = "Bus: " & udBus.ToIElectricalPlantItem.ItemTag
Else
.Cells(lRowCounter, 1) = "Bus: " & udBus.ToIElectricalPlantItem.ItemTag & " (Drill down disabled)"
End If
.Cells(lRowCounter, [col_loadcontinuouskw].Column) = "Rated Voltage: " & udBus.ToIElectricalPlantItem.PropertyValue("RatedVoltage")
.Cells(lRowCounter, [col_xcoincidence].Column) = udBus.XCoincidenceFactor
.Cells(lRowCounter, [col_ycoincidence].Column) = udBus.YCoincidenceFactor
.Cells(lRowCounter, [col_zcoincidence].Column) = udBus.ZCoincidenceFactor
.Cells(lRowCounter, [col_zzcoincidence].Column) = udBus.ZZCoincidenceFactor
With .Range(.Cells(lRowCounter, 1), .Cells(lRowCounter, [col_loadcontinuouskw].Column - 1))
.Merge
.HorizontalAlignment = xlCenter
End With
.Range(.Cells(lRowCounter, [col_loadcontinuouskw].Column), .Cells(lRowCounter, [col_loadsparekvar].Column)).Merge
With .Range(.Cells(lRowCounter, 1), .Cells(lRowCounter, cLastColumn))
With .Interior
.ColorIndex = 15
.Pattern = xlSolid
End With 'Interior
End With
lRowCounter = lRowCounter + 2
End With
Set cOtherCircuits = New Collection
Set objColLoads = udBus.DirectLoads
If objColLoads.count > 0 Then
Cells(lRowCounter, 1) = "Direct Loads:"
Cells(lRowCounter, 1).Font.Bold = True
lRowCounter = lRowCounter + 1
For Each udLoad In objColLoads
bAddLoad = True
'Check for parallel different types loads
If Not udLoad.ToIElectricalPlantItem.CircuitItem Is Nothing Then
With udLoad.ToIElectricalPlantItem.CircuitItem
If .FeededBuses.count = 0 Then
If .DirectConvertingEquipments.count > 0 Then
bAddLoad = False
End If
Else
bAddLoad = False
End If
End With
End If
If bAddLoad Then
FillLoad udLoad, ws, lRowCounter
lRowCounter = lRowCounter + 1
End If
Next
End If
lRowCounter = lRowCounter + 1
If m_bIncludeConverting Then
Set colConvs = udBus.DirectConvertingEquipments
If colConvs.count > 0 Then
Cells(lRowCounter, 1) = "Converting Equipments:"
Cells(lRowCounter, 1).Font.Bold = True
lRowCounter = lRowCounter + 1
For Each udConvertingEquipment In colConvs
FillConvertingEquipment udConvertingEquipment, ws, lRowCounter
lRowCounter = lRowCounter + 1
Next
lRowCounter = lRowCounter + 1
End If
End If
Set objColCircuits = udBus.ToIElectricalPlantItem.ChildrenByItemType(eCircuitItem)
If objColCircuits.count > 0 Then
Cells(lRowCounter, 1) = "Circuits:"
Cells(lRowCounter, 1).Font.Bold = True
lRowCounter = lRowCounter + 1
For Each udCircuit In objColCircuits
If udCircuit.CircuitType = eFeeder And (udCircuit.FeededBuses.count > 0 Or udCircuit.DirectConvertingEquipments.count > 0) Then
FillCircuit udCircuit, ws, lRowCounter
Else
'Couplers and risers
If (udCircuit.CircuitType = eBus_Riser) Or (udCircuit.CircuitType = eCoupler) Then
cOtherCircuits.Add udCircuit
End If
End If
With SelectTotals(udCircuit)
dConActive = dConActive + .ContinuousActive
dConReactive = dConReactive + .ContinuousReactive
dIntActive = dIntActive + .IntermittentActive
dIntReactive = dIntReactive + .IntermittentReactive
dStdActive = dStdActive + .StandbyActive
dStdReactive = dStdReactive + .StandbyReactive
dSpareActive = dSpareActive + .SpareActive
dSpareReactive = dSpareReactive + .SpareReactive
End With
Next udCircuit
For Each udCircuit In cOtherCircuits
Call FillCircuit(udCircuit, ws, lRowCounter)
Next
'Make circuits totals
Cells(lRowCounter, 1) = "Circuits Totals: "
Cells(lRowCounter, 1).Font.Bold = True
Cells(lRowCounter, [col_loadcontinuouskw].Column) = dConActive '& " kW"
Cells(lRowCounter, [col_loadcontinuouskvar].Column) = dConReactive ' & " kVAR"
Cells(lRowCounter, [col_loadintermittentkw].Column) = dIntActive ' & " kW"
Cells(lRowCounter, [col_loadintermittentkvar].Column) = dIntReactive '& " kVAR"
Cells(lRowCounter, [col_loadsparekw].Column) = dSpareActive ' & " kW"
Cells(lRowCounter, [col_loadsparekvar].Column) = dSpareReactive '& " kVAR"
Cells(lRowCounter, [col_loadstandbykw].Column) = dStdActive '& " kW"
Cells(lRowCounter, [col_loadstandbykvar].Column) = dStdReactive '& " kVAR"
lRowCounter = lRowCounter + 1
'Calculate the apparents
Cells(lRowCounter, [col_loadcontinuouskw].Column) = Round(Sqr((dConActive ^ 2 + dConReactive ^ 2)), 3) & " kVA"
Application.Range(Cells(lRowCounter, [col_loadcontinuouskw].Column), Cells(lRowCounter, [col_loadcontinuouskvar].Column)).Merge
Cells(lRowCounter, [col_loadintermittentkw].Column) = Round(Sqr((dIntActive ^ 2 + dIntReactive ^ 2)), 3) & " kVA"
Application.Range(Cells(lRowCounter, [col_loadintermittentkw].Column), Cells(lRowCounter, [col_loadintermittentkvar].Column)).Merge
Cells(lRowCounter, [col_loadsparekw].Column) = Round(Sqr((dSpareActive ^ 2 + dSpareReactive ^ 2)), 3) & " kVA"
Application.Range(Cells(lRowCounter, [col_loadsparekw].Column), Cells(lRowCounter, [col_loadsparekvar].Column)).Merge
Cells(lRowCounter, [col_loadstandbykw].Column) = Round(Sqr((dStdActive ^ 2 + dStdReactive ^ 2)), 3) & " kVA"
Application.Range(Cells(lRowCounter, [col_loadstandbykw].Column), Cells(lRowCounter, [col_loadstandbykvar].Column)).Merge
Application.Range(Cells(lRowCounter - 1, 1), Cells(lRowCounter, cLastColumn)).Interior.ColorIndex = 14
Application.Range(Cells(lRowCounter - 1, 2), Cells(lRowCounter, cLastColumn)).HorizontalAlignment = xlCenter
With Application.Range(Cells(lRowCounter - 1, 1), Cells(lRowCounter, 1))
.Merge
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
End With
lRowCounter = lRowCounter + 1
End If
Set udTotals = SelectCompensatedTotals(udBus)
With ws
.Cells(lRowCounter + 2, 1) = sNormalLoad
.Cells(lRowCounter + 2, 1).Font.Bold = True
.Cells(lRowCounter + 2, 1).WrapText = False
.Cells(lRowCounter + 3, 1) = Round(udTotals.RunActive, 3) & " kW"
.Cells(lRowCounter + 4, 1) = Round(udTotals.RunReactive, 3) & " kVAr"
.Cells(lRowCounter + 5, 1) = Round(udTotals.RunApparent, 3) & " kVA"
.Cells(lRowCounter + 6, 1) = "Power factor: " & Round(udTotals.RunPowerFactor, 3)
.Cells(lRowCounter + 8, 1) = sPeakLoad
.Cells(lRowCounter + 8, 1).Font.Bold = True
.Cells(lRowCounter + 8, 1).WrapText = False
.Cells(lRowCounter + 9, 1) = Round(udTotals.PeakActive, 3) & " kW"
.Cells(lRowCounter + 10, 1) = Round(udTotals.PeakReactive, 3) & " kVAr"
.Cells(lRowCounter + 11, 1) = Round(udTotals.PeakApparent, 3) & " kVA"
.Cells(lRowCounter + 12, 1) = "Power factor: " & Round(udTotals.PeakPowerFactor, 3)
lRowCounter = lRowCounter + 13
End With 'ws
Set udTotals = Nothing
Set cOtherCircuits = Nothing
Call FindnCalculate
End Function
Private Function FindnCalculate()
Dim fn As Long
Dim cnt As Long
cnt = Range("A" & Rows.count).End(xlDown).Row
For fn = 1 To cnt
If dConActive <> "" Then 'Cells(lRowCounter, [col_loadcontinuouskw].Column)
fn = fn + 2
Cells(fn, "A") = "LOAD SUMMARY:"
Cells(fn, "B") = mykW
mykW = dConActive + (dIntActive * 0.3) + dStdActive
Cells(fn, "C") = mykVar
kVar = dConReactive + (dIntReactive * 0.3) + dStdReactive
Cells(fn, "C") = mykVA
mykVA = mykW + kVar
End If
End Function
Private Function IsStringInCol(col As Collection, str As String) As Boolean
Dim vnt As Variant
Dim s As String
For Each vnt In col
s = vnt
If StrComp(s, str, vbBinaryCompare) = 0 Then
IsStringInCol = True
Exit Function
End If
Next vnt
IsStringInCol = False
End Function
Private Function SelectCompensatedTotals(objPlantItem As IElectricalPlantItem) As Object
Select Case m_eRatedConsumed
Case eRated
Set SelectCompensatedTotals = objPlantItem.TotalCompensatedRated
Case eConsumed
Set SelectCompensatedTotals = objPlantItem.TotalCompensatedConsumed
End Select
End Function
Private Function SelectTotals(objPlantItem As IElectricalPlantItem) As Object
Select Case m_eRatedConsumed
Case eRated
Select Case m_eCompensatedUnCompensated
Case eCompensated
Set SelectTotals = objPlantItem.TotalCompensatedRated
Case eUnCompensated
Set SelectTotals = objPlantItem.TotalUnCompensatedRated
End Select
Case eConsumed
Select Case m_eCompensatedUnCompensated
Case eCompensated
Set SelectTotals = objPlantItem.TotalCompensatedConsumed
Case eUnCompensated
Set SelectTotals = objPlantItem.TotalUnCompensatedConsumed
End Select
End Select
End Function