Error while opening excel sheet

VBABEGINER

Well-known Member
Joined
Jun 15, 2011
Messages
1,284
Office Version
  1. 365
Platform
  1. 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 !!

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
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK

Forum statistics

Threads
1,224,517
Messages
6,179,239
Members
452,898
Latest member
Capolavoro009

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top