Attribute VB_Name = "CrearInforme" Option Explicit Dim ApExcel As Variant Public distanciaPostes As Single Dim i As Integer Dim filaGeneral As Integer Dim filalin1 As Integer Dim filalin2 As Integer Dim filaObstac As Integer Dim FilaLazo As Integer Dim FilaCostes As Integer Dim FAmin As Single Dim FAmax As Single Dim nombreConductor As String Dim RConductor As String Dim rgmConductor As String Dim costeConductor As String Dim nombrePoste As String Dim alturaPoste As String Dim costePoste As String Dim numPostes As Integer Dim esteLazo As Integer Sub General() FAmin = 500 FAmax = 0 Espere.Show ' Si no se ha resuelto el problema se resuelve pero sin mostrar ninguna gráfica ' para así ser transparente al usuario. If Principal.resuelto = False Then ' Creamos los ficheros Campo.ficherosMicampoNoGraficas ' Obtenemos resultados Shell (App.Path & "\calculos\micamponograf.exe") While Len(Dir$(App.Path & "\calculos\campo.txt")) = 0 Wend End If Unload Espere ' Abrimos una instancia de Excel. Set ApExcel = CreateObject("Excel.application") ApExcel.Workbooks.Add ' Lo mostramos ApExcel.Visible = True ' Ajustamos el ancho de las columnas ApExcel.Columns("B").columnwidth = 21 ApExcel.Columns("C:G").columnwidth = 10 ApExcel.Columns("A").columnwidth = 3 filaGeneral = 2 If Principal.idioma = "Español" Then ' Ponemos los datos generales ApExcel.cells(filaGeneral, 2).formula = "DATOS GENERALES DEL PROYECTO" ApExcel.cells(filaGeneral, 2).Select ApExcel.Selection.Font.Bold = True filaGeneral = filaGeneral + 2 ApExcel.cells(filaGeneral, 2).formula = "Autor: " ApExcel.cells(filaGeneral, 3).formula = Principal.autor filaGeneral = filaGeneral + 1 ApExcel.cells(filaGeneral, 2).formula = "Fecha: " ApExcel.cells(filaGeneral, 3).formula = Principal.fecha filaGeneral = filaGeneral + 1 ApExcel.cells(filaGeneral, 2).formula = "Descripción: " ApExcel.cells(filaGeneral, 3).formula = Principal.descripcion PonLineas PonObstaculos PonlazosPasivos PonlazosActivos If esteLazo > 0 Then ponCostes End If ponGraficas Else ' Ponemos los datos generales ApExcel.cells(filaGeneral, 2).formula = "GENERAL DATA FROM PROJECT" ApExcel.cells(filaGeneral, 2).Select ApExcel.Selection.Font.Bold = True filaGeneral = filaGeneral + 2 ApExcel.cells(filaGeneral, 2).formula = "Author: " ApExcel.cells(filaGeneral, 3).formula = Principal.autor filaGeneral = filaGeneral + 1 ApExcel.cells(filaGeneral, 2).formula = "Date: " ApExcel.cells(filaGeneral, 3).formula = Principal.fecha filaGeneral = filaGeneral + 1 ApExcel.cells(filaGeneral, 2).formula = "Description: " ApExcel.cells(filaGeneral, 3).formula = Principal.descripcion PutLines PutObstacles PutPassiveLoops PutActiveLoops If esteLazo > 0 Then putCosts End If putGraphs End If End Sub Sub putCosts() Dim longTransversal As Single Dim longLongitudinal As Single Dim costeCondTotal As Single Dim costePosteTotal As Single FilaCostes = FilaLazo + 3 ApExcel.cells(FilaCostes, 2).formula = "Conductor Costs" ApExcel.cells(FilaCostes, 2).Select ApExcel.Selection.Font.Bold = True FilaCostes = FilaCostes + 2 ' Ponemos cabeceras ApExcel.cells(FilaCostes, 2).formula = "Name" ApExcel.cells(FilaCostes, 3).formula = "R'(ohm/km)" ApExcel.cells(FilaCostes, 4).formula = "RGM (m)" ApExcel.cells(FilaCostes, 5).formula = "L (m)" ApExcel.cells(FilaCostes, 6).formula = "Cost(€/km)" ApExcel.cells(FilaCostes, 7).formula = "Cost (€)" ' Formato de la cabecera ApExcel.range("A" & CStr(FilaCostes) & ":P" & CStr(FilaCostes)).Select With ApExcel.Selection .HorizontalAlignment = -4108 End With ' Ponemos los datos del lazo elegido FilaCostes = FilaCostes + 1 ApExcel.cells(FilaCostes, 2).formula = Lazos(esteLazo).nombreConductor ApExcel.cells(FilaCostes, 3).formula = CSng(Lazos(esteLazo).RConductor) ApExcel.cells(FilaCostes, 4).formula = CSng(Lazos(esteLazo).rgmConductor) ApExcel.cells(FilaCostes, 5).formula = CSng(Lazos(esteLazo).longitud) ApExcel.cells(FilaCostes, 6).formula = CSng(Lazos(esteLazo).costeConductor) ' Calculamos el coste total, suma del transversal más el logitudinal ' Longitud transversal Select Case Lazos(esteLazo).tipo Case Is = 2 longTransversal = Sqr((Lazos(esteLazo).x1 - Lazos(esteLazo).x2) ^ 2 + (Lazos(esteLazo).y1 - _ Lazos(esteLazo).y2) ^ 2) Case Is = 3 longTransversal = Sqr((Lazos(esteLazo).x1 - Lazos(esteLazo).x2) ^ 2 + (Lazos(esteLazo).y1 - _ Lazos(esteLazo).y2) ^ 2) longTransversal = longTransversal + Sqr((Lazos(esteLazo).x2 - Lazos(esteLazo).x3) ^ 2 + _ (Lazos(esteLazo).y2 - Lazos(esteLazo).y3) ^ 2) Case Is = 4 longTransversal = Sqr((Lazos(esteLazo).x1 - Lazos(esteLazo).x2) ^ 2 + (Lazos(esteLazo).y1 - _ Lazos(esteLazo).y2) ^ 2) longTransversal = longTransversal + Sqr((Lazos(esteLazo).x3 - Lazos(esteLazo).x4) ^ 2 + _ (Lazos(esteLazo).y3 - Lazos(esteLazo).y4) ^ 2) End Select ' Longitud longitudinal longLongitudinal = Lazos(esteLazo).longitud ' Coste total costeCondTotal = (longTransversal + longLongitudinal) * Lazos(esteLazo).costeConductor ' Lo ponemos en excel ApExcel.cells(FilaCostes, 7).formula = costeCondTotal ' ************************************************************************************************************* ' Y ahora los postes FilaCostes = FilaCostes + 3 ApExcel.cells(FilaCostes, 2).formula = "Towers cost" ApExcel.cells(FilaCostes, 2).Select ApExcel.Selection.Font.Bold = True FilaCostes = FilaCostes + 2 ' Ponemos cabeceras ApExcel.cells(FilaCostes, 2).formula = "Name" ApExcel.cells(FilaCostes, 3).formula = "Height (m)" ApExcel.cells(FilaCostes, 4).formula = "Cost (€/ud)" ApExcel.cells(FilaCostes, 5).formula = "Amount" ApExcel.cells(FilaCostes, 6).formula = "Cost(€)" ' Formato de la cabecera ApExcel.range("A" & CStr(FilaCostes) & ":P" & CStr(FilaCostes)).Select With ApExcel.Selection .HorizontalAlignment = -4108 End With Select Case Lazos(esteLazo).tipo Dim postesLong As Integer Dim postesTransv As Integer Dim postesTransv2 As Integer Case Is = 2 postesLong = 2 * Fix((Lazos(esteLazo).longitud) / distanciaPostes) postesTransv = 2 * (Fix((Lazos(esteLazo).x2 - Lazos(esteLazo).x1) / distanciaPostes) + 2) Case Is = 3 postesLong = 3 * Fix((Lazos(esteLazo).longitud) / distanciaPostes) postesTransv = 2 * (Fix((Lazos(esteLazo).x2 - Lazos(esteLazo).x1) / distanciaPostes) + 1) postesTransv2 = 2 * (Fix((Lazos(esteLazo).x3 - Lazos(esteLazo).x2) / distanciaPostes) + 2) Case Is = 4 postesLong = 4 * Fix((Lazos(esteLazo).longitud) / distanciaPostes) postesTransv = 2 * (Fix((Lazos(esteLazo).x2 - Lazos(esteLazo).x1) / distanciaPostes) + 2) postesTransv2 = 2 * (Fix((Lazos(esteLazo).x4 - Lazos(esteLazo).x3) / distanciaPostes) + 2) End Select FilaCostes = FilaCostes + 1 ApExcel.cells(FilaCostes, 2) = Lazos(esteLazo).nombrePoste ApExcel.cells(FilaCostes, 3) = Lazos(esteLazo).alturaPoste ApExcel.cells(FilaCostes, 4) = CSng(Lazos(esteLazo).costePoste) ApExcel.cells(FilaCostes, 5) = (postesLong + postesTransv + postesTransv2) ApExcel.cells(FilaCostes, 6) = CSng(Lazos(esteLazo).costePoste * 2 * _ (postesLong + postesTransv + postesTransv2)) End Sub Sub ponCostes() Dim longTransversal As Single Dim longLongitudinal As Single Dim costeCondTotal As Single Dim costePosteTotal As Single FilaCostes = FilaLazo + 3 ApExcel.cells(FilaCostes, 2).formula = "Costes Conductor" ApExcel.cells(FilaCostes, 2).Select ApExcel.Selection.Font.Bold = True FilaCostes = FilaCostes + 2 ' Ponemos cabeceras ApExcel.cells(FilaCostes, 2).formula = "Nombre" ApExcel.cells(FilaCostes, 3).formula = "R'(ohm/km)" ApExcel.cells(FilaCostes, 4).formula = "RGM (m)" ApExcel.cells(FilaCostes, 5).formula = "L (m)" ApExcel.cells(FilaCostes, 6).formula = "Coste(€/km)" ApExcel.cells(FilaCostes, 7).formula = "Coste (€)" ' Formato de la cabecera ApExcel.range("A" & CStr(FilaCostes) & ":P" & CStr(FilaCostes)).Select With ApExcel.Selection .HorizontalAlignment = -4108 End With ' Ponemos los datos del lazo elegido. FilaCostes = FilaCostes + 1 ApExcel.cells(FilaCostes, 2).formula = Lazos(esteLazo).nombreConductor ApExcel.cells(FilaCostes, 3).formula = CSng(Lazos(esteLazo).RConductor) ApExcel.cells(FilaCostes, 4).formula = CSng(Lazos(esteLazo).rgmConductor) ApExcel.cells(FilaCostes, 5).formula = CSng(Lazos(esteLazo).longitud) ApExcel.cells(FilaCostes, 6).formula = CSng(Lazos(esteLazo).costeConductor) ' Calculamos el coste total, suma del transversal más el logitudinal ' Longitud transversal Select Case Lazos(esteLazo).tipo Case Is = 2 longTransversal = Sqr((Lazos(esteLazo).x1 - Lazos(esteLazo).x2) ^ 2 + (Lazos(esteLazo).y1 - _ Lazos(esteLazo).y2) ^ 2) Case Is = 3 longTransversal = Sqr((Lazos(esteLazo).x1 - Lazos(esteLazo).x2) ^ 2 + (Lazos(esteLazo).y1 - _ Lazos(esteLazo).y2) ^ 2) longTransversal = longTransversal + Sqr((Lazos(esteLazo).x2 - Lazos(esteLazo).x3) ^ 2 + _ (Lazos(esteLazo).y2 - Lazos(esteLazo).y3) ^ 2) Case Is = 4 longTransversal = Sqr((Lazos(esteLazo).x1 - Lazos(esteLazo).x2) ^ 2 + (Lazos(esteLazo).y1 - _ Lazos(esteLazo).y2) ^ 2) longTransversal = longTransversal + Sqr((Lazos(esteLazo).x3 - Lazos(esteLazo).x4) ^ 2 + _ (Lazos(esteLazo).y3 - Lazos(esteLazo).y4) ^ 2) End Select ' Longitud longitudinal longLongitudinal = Lazos(esteLazo).longitud ' Coste total costeCondTotal = (longTransversal + longLongitudinal) * Lazos(esteLazo).costeConductor ' Lo ponemos en excel ApExcel.cells(FilaCostes, 7).formula = costeCondTotal ' ************************************************************************************************************* ' Y ahora los postes FilaCostes = FilaCostes + 3 ApExcel.cells(FilaCostes, 2).formula = "Coste de Postes" ApExcel.cells(FilaCostes, 2).Select ApExcel.Selection.Font.Bold = True FilaCostes = FilaCostes + 2 ' Ponemos cabeceras ApExcel.cells(FilaCostes, 2).formula = "Nombre" ApExcel.cells(FilaCostes, 3).formula = "Altura (m)" ApExcel.cells(FilaCostes, 4).formula = "Coste (€/ud)" ApExcel.cells(FilaCostes, 5).formula = "Número" ApExcel.cells(FilaCostes, 6).formula = "Coste(€)" ' Formato de la cabecera ApExcel.range("A" & CStr(FilaCostes) & ":P" & CStr(FilaCostes)).Select With ApExcel.Selection .HorizontalAlignment = -4108 End With Select Case Lazos(esteLazo).tipo Dim postesLong As Integer Dim postesTransv As Integer Dim postesTransv2 As Integer Case Is = 2 postesLong = 2 * Fix((Lazos(esteLazo).longitud) / distanciaPostes) postesTransv = 2 * (Fix((Lazos(esteLazo).x2 - Lazos(esteLazo).x1) / distanciaPostes) + 2) Case Is = 3 postesLong = 3 * Fix((Lazos(esteLazo).longitud) / distanciaPostes) postesTransv = 2 * (Fix((Lazos(esteLazo).x2 - Lazos(esteLazo).x1) / distanciaPostes) + 1) postesTransv2 = 2 * (Fix((Lazos(esteLazo).x3 - Lazos(esteLazo).x2) / distanciaPostes) + 2) Case Is = 4 postesLong = 4 * Fix((Lazos(esteLazo).longitud) / distanciaPostes) postesTransv = 2 * (Fix((Lazos(esteLazo).x2 - Lazos(esteLazo).x1) / distanciaPostes) + 2) postesTransv2 = 2 * (Fix((Lazos(esteLazo).x4 - Lazos(esteLazo).x3) / distanciaPostes) + 2) End Select FilaCostes = FilaCostes + 1 ApExcel.cells(FilaCostes, 2) = Lazos(esteLazo).nombrePoste ApExcel.cells(FilaCostes, 3) = Lazos(esteLazo).alturaPoste ApExcel.cells(FilaCostes, 4) = CSng(Lazos(esteLazo).costePoste) ApExcel.cells(FilaCostes, 5) = (postesLong + postesTransv + postesTransv2) ApExcel.cells(FilaCostes, 6) = CSng(Lazos(esteLazo).costePoste * 2 * _ (postesLong + postesTransv + postesTransv2)) End Sub Sub ponGraficas() ' Abrimos el fichero 'campo.txt', si existe. Dim fichCampo As Integer Dim linea As String Dim pos As Integer Dim posAnt As Integer Dim fila As Long Dim X As String Dim xmin As Single Dim xmax As Single Dim campolin As String Dim campolaz As String Dim campotot As String Dim xminBueno As Single Dim xmaxBueno As Single xmin = 0 xmax = 0 fila = 3 fichCampo = FreeFile ' Ponemos cabeceras ApExcel.sheets("Hoja2").cells(1, 1).formula = "X" ApExcel.sheets("Hoja2").cells(2, 1).formula = "(m)" ApExcel.sheets("Hoja2").cells(1, 2).formula = "B Linea" ApExcel.sheets("Hoja2").cells(2, 2).formula = "(uT)" ApExcel.sheets("Hoja2").cells(1, 3).formula = "B lazo" ApExcel.sheets("Hoja2").cells(2, 3).formula = "(uT)" ApExcel.sheets("Hoja2").cells(1, 4).formula = "B neto" ApExcel.sheets("Hoja2").cells(2, 4).formula = "(uT)" ApExcel.sheets("Hoja2").Activate ApExcel.sheets("Hoja2").range("A1:G2").Select With ApExcel.Selection .HorizontalAlignment = -4108 End With ' Seleccionamos la segunda hoja del libro y le ponemos el nombre ApExcel.sheets("Hoja2").Select ApExcel.sheets("Hoja2").Name = "Campo" If Len(Dir$(App.Path & "\calculos\campo.txt")) > 0 Then Open (App.Path & "\calculos\campo.txt") For Input As fichCampo ' Leemos la linea del fichero While (Not EOF(fichCampo)) Line Input #fichCampo, linea ' Cambiamos las ',' por ';' linea = Replace(linea, ",", ";") ' Cambiamos los '.' por ',' linea = Replace(linea, ".", ",") ' Obtenemos los valores de x, campo linea, campo lazo y campo total posAnt = 0 pos = InStr(1, linea, ";") X = Trim(Mid(linea, 1, pos - posAnt - 1)) If CSng(X) < xmin Then xmin = CSng(X) End If If CSng(X) > xmax Then xmax = CSng(X) End If posAnt = pos pos = InStr(pos + 1, linea, ";") campolin = Trim(Mid(linea, posAnt + 1, pos - posAnt - 1)) posAnt = pos pos = InStr(pos + 1, linea, ";") campolaz = Trim(Mid(linea, posAnt + 1, pos - posAnt - 1)) campotot = Trim(Mid(linea, pos + 1, Len(linea) - pos - 1)) ' Ponemos todos los datos en formato numero con 2 decimales ApExcel.range("A" & CStr(fila) & ":D" & CStr(fila)).Select ApExcel.Selection.NumberFormat = "0.00" ' Escribimos los valores en excel ApExcel.sheets("Campo").cells(fila, 1).formula = CSng(X) ApExcel.sheets("Campo").cells(fila, 2).formula = CSng(campolin) ApExcel.sheets("Campo").cells(fila, 3).formula = CSng(campolaz) ApExcel.sheets("Campo").cells(fila, 4).formula = CSng(campotot) fila = fila + 1 Wend Close fichCampo ApExcel.sheets("campo").cells(1, 1).Select ' Ahora representamos la grafica de campo ApExcel.Charts.Add ApExcel.ActiveChart.chartType = 73 ApExcel.ActiveChart.SetSourceData Source:=ApExcel.sheets("Campo").range("G9") ApExcel.ActiveChart.SeriesCollection.NewSeries ApExcel.ActiveChart.SeriesCollection.NewSeries ApExcel.ActiveChart.SeriesCollection.NewSeries ApExcel.ActiveChart.SeriesCollection(1).XValues = "=Campo!R3C1:R" & CStr(fila) & "C1" ApExcel.ActiveChart.SeriesCollection(1).Values = "=Campo!R3C2:R" & CStr(fila) & "C2" ApExcel.ActiveChart.SeriesCollection(1).Name = "=""B Línea""" ApExcel.ActiveChart.SeriesCollection(2).XValues = "=Campo!R3C1:R" & CStr(fila) & "C1" ApExcel.ActiveChart.SeriesCollection(2).Values = "=Campo!R3C3:R" & CStr(fila) & "C3" ApExcel.ActiveChart.SeriesCollection(2).Name = "=""B Lazo""" ApExcel.ActiveChart.SeriesCollection(3).XValues = "=Campo!R3C1:R" & CStr(fila) & "C1" ApExcel.ActiveChart.SeriesCollection(3).Values = "=Campo!R3C4:R" & CStr(fila) & "C4" ApExcel.ActiveChart.SeriesCollection(3).Name = "=""B Total""" ApExcel.ActiveChart.Location Where:=2, Name:="Campo" With ApExcel.ActiveChart .HasTitle = False .Axes(1, 1).HasTitle = True .Axes(1, 1).AxisTitle.Characters.Text = "X (m)" .Axes(2, 1).HasTitle = True .Axes(2, 1).AxisTitle.Characters.Text = "B (uT)" End With xminBueno = 0 While (xminBueno >= xmin) xminBueno = xminBueno - 10 Wend xmaxBueno = 0 While (xmaxBueno <= xmax) xmaxBueno = xmaxBueno + 10 Wend With ApExcel.ActiveChart.Axes(1) .ticklabels.NumberFormat = "General" .MinimumScale = xminBueno .MaximumScale = xmaxBueno .MinorUnitIsAuto = True .MajorUnitIsAuto = True .Crosses = -4114 .CrossesAt = xminBueno .ReversePlotOrder = False .ScaleType = -4132 .DisplayUnit = -4142 End With With ApExcel.ActiveChart.Axes(2) .MinimumScale = 0 .MaximumScaleIsAuto = True .MinorUnitIsAuto = True .MajorUnitIsAuto = True .Crosses = -4105 .ReversePlotOrder = False .ScaleType = -4132 .DisplayUnit = -4142 End With End If ' Y ahora el grafico del factor de reducción fichCampo = FreeFile ' Ponemos cabeceras ApExcel.sheets("Campo").cells(1, 5).formula = "FA" ApExcel.sheets("Campo").cells(2, 5).formula = "[]" If Len(Dir$(App.Path & "\calculos\fa.txt")) > 0 Then fila = 3 Open (App.Path & "\calculos\fa.txt") For Input As fichCampo ApExcel.sheets("Campo").cells(1, 1).Select ' Leemos la linea del fichero While (Not EOF(fichCampo)) ' Ponemos todos los datos en formato numero con 2 decimales ApExcel.sheets("Campo").range("E" & CStr(fila) & ":E" & CStr(fila)).Select ApExcel.Selection.NumberFormat = "0.0000" Line Input #fichCampo, linea ' Cambiamos las ',' por ';' linea = Replace(linea, ",", ";") ' Cambiamos los '.' por ',' linea = Replace(linea, ".", ",") ' Obtenemos los valores de x, campo linea, campo lazo y campo total posAnt = 0 pos = InStr(1, linea, ";") X = Trim(Mid(linea, 1, pos - posAnt - 1)) If CSng(X) < xmin Then xmin = CSng(X) End If If CSng(X) > xmax Then xmax = CSng(X) End If linea = Trim(Mid(linea, pos + 1, Len(linea) - pos - 1)) If CSng(linea) < FAmin Then FAmin = CSng(linea) End If If CSng(linea) > FAmax Then FAmax = CSng(linea) End If ' Escribimos los valores en excel ApExcel.sheets("Campo").cells(fila, 5).formula = CSng(linea) fila = fila + 1 Wend Close fichCampo ' Nos vamos al principio de la hoja ApExcel.sheets("campo").cells(1, 1).Select ' Ahora representamos la grafica de campo ApExcel.Charts.Add ApExcel.ActiveChart.chartType = 73 ApExcel.ActiveChart.Legend.Delete ApExcel.ActiveChart.SeriesCollection(1).XValues = "=Campo!R3C1:R" & CStr(fila) & "C1" ApExcel.ActiveChart.SeriesCollection(1).Values = "=Campo!R3C5:R" & CStr(fila) & "C5" ApExcel.ActiveChart.SeriesCollection(1).Name = "=""""" ApExcel.ActiveChart.Location Where:=2, Name:="Campo" ' Calculamos los valores 'bonitos' mas cercanos a los que hemos obtenido a pelo Dim FAmaxBueno As Single Dim FAminBueno As Single xminBueno = 0 While (xminBueno >= xmin) xminBueno = xminBueno - 10 Wend xmaxBueno = 0 While (xmaxBueno <= xmax) xmaxBueno = xmaxBueno + 10 Wend FAmaxBueno = 0 While (FAmaxBueno <= FAmax) FAmaxBueno = FAmaxBueno + 0.5 Wend FAminBueno = 5 While (FAminBueno >= FAmin) FAminBueno = FAminBueno - 0.5 Wend Dim posi As Integer posi = InStr(1, FAminBueno, ",") ApExcel.ActiveChart.Axes(1).ticklabels.NumberFormat = "General" ApExcel.ActiveChart.Axes(1).Select With ApExcel.ActiveChart.Axes(1) .MinimumScale = xminBueno .MaximumScale = xmaxBueno .MaximumScaleIsAuto = False .MinorUnitIsAuto = True .MajorUnitIsAuto = True End With ApExcel.ActiveChart.Axes(2).Select With ApExcel.ActiveChart.Axes(2) .MinimumScale = FAminBueno .MaximumScale = FAmaxBueno .MaximumScaleIsAuto = False .MinorUnitIsAuto = True .MajorUnitIsAuto = True .hasMajorGridlines = False End With With ApExcel.ActiveChart .HasTitle = False .Axes(1, 1).HasTitle = True .Axes(1, 1).AxisTitle.Characters.Text = "X (m)" .Axes(2, 1).HasTitle = True .Axes(2, 1).AxisTitle.Characters.Text = "FR" End With With ApExcel.ActiveChart.Axes(1) .MinimumScale = CSng(xminBueno) .MaximumScale = CSng(xmaxBueno) .MinorUnit = 10 .MajorUnit = 10 .Crosses = -4114 .CrossesAt = xminBueno .ReversePlotOrder = False .ScaleType = -4132 .DisplayUnit = -4142 End With ' Ponemos los limites de los ejes un poco mas adornados ApExcel.ActiveSheet.ChartObjects("Gráfico 2").Activate ApExcel.ActiveChart.ChartArea.Select ApExcel.ActiveChart.Axes(2).Select ApExcel.Selection.ticklabels.NumberFormat = "0.00" ApExcel.ActiveSheet.ChartObjects("Gráfico 1").Activate ApExcel.ActiveChart.ChartArea.Select ApExcel.ActiveSheet.Shapes("Gráfico 1").ScaleWidth 1.2, 0, 0 ApExcel.ActiveSheet.Shapes("Gráfico 1").ScaleHeight 1.68, 0, 0 ApExcel.ActiveSheet.ChartObjects("Gráfico 2").Activate ApExcel.ActiveChart.ChartArea.Select ApExcel.ActiveSheet.Shapes("Gráfico 2").ScaleWidth 1.2, 0, 0 ApExcel.ActiveSheet.Shapes("Gráfico 2").ScaleHeight 1.68, 0, 0 End If End Sub Sub putGraphs() ' Abrimos el fichero 'campo.txt', si existe. Dim fichCampo As Integer Dim linea As String Dim pos As Integer Dim posAnt As Integer Dim fila As Long Dim X As String Dim xmin As Single Dim xmax As Single Dim campolin As String Dim campolaz As String Dim campotot As String Dim xminBueno As Single Dim xmaxBueno As Single xmin = 0 xmax = 0 fila = 3 fichCampo = FreeFile ' Ponemos cabeceras ApExcel.sheets("Hoja2").cells(1, 1).formula = "X" ApExcel.sheets("Hoja2").cells(2, 1).formula = "(m)" ApExcel.sheets("Hoja2").cells(1, 2).formula = "B(Line)" ApExcel.sheets("Hoja2").cells(2, 2).formula = "(uT)" ApExcel.sheets("Hoja2").cells(1, 3).formula = "B(Loop)" ApExcel.sheets("Hoja2").cells(2, 3).formula = "(uT)" ApExcel.sheets("Hoja2").cells(1, 4).formula = "B(final)" ApExcel.sheets("Hoja2").cells(2, 4).formula = "(uT)" ApExcel.sheets("Hoja2").Activate ApExcel.sheets("Hoja2").range("A1:G2").Select With ApExcel.Selection .HorizontalAlignment = -4108 End With ' Seleccionamos la segunda hoja del libro y le ponemos el nombre ApExcel.sheets("Hoja2").Select ApExcel.sheets("Hoja2").Name = "Field" If Len(Dir$(App.Path & "\calculos\campo.txt")) > 0 Then Open (App.Path & "\calculos\campo.txt") For Input As fichCampo ' Leemos la linea del fichero While (Not EOF(fichCampo)) Line Input #fichCampo, linea ' Cambiamos las ',' por ';' linea = Replace(linea, ",", ";") ' Cambiamos los '.' por ',' linea = Replace(linea, ".", ",") ' Obtenemos los valores de x, campo linea, campo lazo y campo total posAnt = 0 pos = InStr(1, linea, ";") X = Trim(Mid(linea, 1, pos - posAnt - 1)) If CSng(X) < xmin Then xmin = CSng(X) End If If CSng(X) > xmax Then xmax = CSng(X) End If posAnt = pos pos = InStr(pos + 1, linea, ";") campolin = Trim(Mid(linea, posAnt + 1, pos - posAnt - 1)) posAnt = pos pos = InStr(pos + 1, linea, ";") campolaz = Trim(Mid(linea, posAnt + 1, pos - posAnt - 1)) campotot = Trim(Mid(linea, pos + 1, Len(linea) - pos - 1)) ' Ponemos todos los datos en formato numero con 2 decimales ApExcel.range("A" & CStr(fila) & ":D" & CStr(fila)).Select ApExcel.Selection.NumberFormat = "0.00" ' Escribimos los valores en excel ApExcel.sheets("Field").cells(fila, 1).formula = CSng(X) ApExcel.sheets("Field").cells(fila, 2).formula = CSng(campolin) ApExcel.sheets("Field").cells(fila, 3).formula = CSng(campolaz) ApExcel.sheets("Field").cells(fila, 4).formula = CSng(campotot) fila = fila + 1 Wend Close fichCampo ApExcel.sheets("Field").cells(1, 1).Select ' Ahora representamos la grafica de campo ApExcel.Charts.Add ApExcel.ActiveChart.chartType = 73 ApExcel.ActiveChart.SetSourceData Source:=ApExcel.sheets("Field").range("G9") ApExcel.ActiveChart.SeriesCollection.NewSeries ApExcel.ActiveChart.SeriesCollection.NewSeries ApExcel.ActiveChart.SeriesCollection.NewSeries ApExcel.ActiveChart.SeriesCollection(1).XValues = "=Field!R3C1:R" & CStr(fila) & "C1" ApExcel.ActiveChart.SeriesCollection(1).Values = "=Field!R3C2:R" & CStr(fila) & "C2" ApExcel.ActiveChart.SeriesCollection(1).Name = "=""B(Line)""" ApExcel.ActiveChart.SeriesCollection(2).XValues = "=Field!R3C1:R" & CStr(fila) & "C1" ApExcel.ActiveChart.SeriesCollection(2).Values = "=Field!R3C3:R" & CStr(fila) & "C3" ApExcel.ActiveChart.SeriesCollection(2).Name = "=""B(Loop)""" ApExcel.ActiveChart.SeriesCollection(3).XValues = "=Field!R3C1:R" & CStr(fila) & "C1" ApExcel.ActiveChart.SeriesCollection(3).Values = "=Field!R3C4:R" & CStr(fila) & "C4" ApExcel.ActiveChart.SeriesCollection(3).Name = "=""B(Final)""" ApExcel.ActiveChart.Location Where:=2, Name:="Field" With ApExcel.ActiveChart .HasTitle = False .Axes(1, 1).HasTitle = True .Axes(1, 1).AxisTitle.Characters.Text = "X (m)" .Axes(2, 1).HasTitle = True .Axes(2, 1).AxisTitle.Characters.Text = "B (uT)" End With xminBueno = 0 While (xminBueno >= xmin) xminBueno = xminBueno - 10 Wend xmaxBueno = 0 While (xmaxBueno <= xmax) xmaxBueno = xmaxBueno + 10 Wend With ApExcel.ActiveChart.Axes(1) .ticklabels.NumberFormat = "General" .MinimumScale = xminBueno .MaximumScale = xmaxBueno .MinorUnitIsAuto = True .MajorUnitIsAuto = True .Crosses = -4114 .CrossesAt = xminBueno .ReversePlotOrder = False .ScaleType = -4132 .DisplayUnit = -4142 End With With ApExcel.ActiveChart.Axes(2) .MinimumScale = 0 .MaximumScaleIsAuto = True .MinorUnitIsAuto = True .MajorUnitIsAuto = True .Crosses = -4105 .ReversePlotOrder = False .ScaleType = -4132 .DisplayUnit = -4142 End With End If ' Y ahora el grafico del factor de reducción fichCampo = FreeFile ' Ponemos cabeceras ApExcel.sheets("Field").cells(1, 5).formula = "FA" ApExcel.sheets("Field").cells(2, 5).formula = "[]" If Len(Dir$(App.Path & "\calculos\fa.txt")) > 0 Then fila = 3 Open (App.Path & "\calculos\fa.txt") For Input As fichCampo ApExcel.sheets("Field").cells(1, 1).Select ' Leemos la linea del fichero While (Not EOF(fichCampo)) ' Ponemos todos los datos en formato numero con 2 decimales ApExcel.sheets("Field").range("E" & CStr(fila) & ":E" & CStr(fila)).Select ApExcel.Selection.NumberFormat = "0.0000" Line Input #fichCampo, linea ' Cambiamos las ',' por ';' linea = Replace(linea, ",", ";") ' Cambiamos los '.' por ',' linea = Replace(linea, ".", ",") ' Obtenemos los valores de x, campo linea, campo lazo y campo total posAnt = 0 pos = InStr(1, linea, ";") X = Trim(Mid(linea, 1, pos - posAnt - 1)) If CSng(X) < xmin Then xmin = CSng(X) End If If CSng(X) > xmax Then xmax = CSng(X) End If linea = Trim(Mid(linea, pos + 1, Len(linea) - pos - 1)) If CSng(linea) < FAmin Then FAmin = CSng(linea) End If If CSng(linea) > FAmax Then FAmax = CSng(linea) End If ' Escribimos los valores en excel ApExcel.sheets("Field").cells(fila, 5).formula = CSng(linea) fila = fila + 1 Wend Close fichCampo ' Nos vamos al principio de la hoja ApExcel.sheets("Field").cells(1, 1).Select ' Ahora representamos la grafica de campo ApExcel.Charts.Add ApExcel.ActiveChart.chartType = 73 ApExcel.ActiveChart.Legend.Delete ApExcel.ActiveChart.SeriesCollection(1).XValues = "=Field!R3C1:R" & CStr(fila) & "C1" ApExcel.ActiveChart.SeriesCollection(1).Values = "=Field!R3C5:R" & CStr(fila) & "C5" ApExcel.ActiveChart.SeriesCollection(1).Name = "=""""" ApExcel.ActiveChart.Location Where:=2, Name:="Field" ' Calculamos los valores 'bonitos' mas cercanos a los que hemos obtenido a pelo Dim FAmaxBueno As Single Dim FAminBueno As Single xminBueno = 0 While (xminBueno >= xmin) xminBueno = xminBueno - 10 Wend xmaxBueno = 0 While (xmaxBueno <= xmax) xmaxBueno = xmaxBueno + 10 Wend FAmaxBueno = 0 While (FAmaxBueno <= FAmax) FAmaxBueno = FAmaxBueno + 0.5 Wend FAminBueno = 5 While (FAminBueno >= FAmin) FAminBueno = FAminBueno - 0.5 Wend Dim posi As Integer posi = InStr(1, FAminBueno, ",") ApExcel.ActiveChart.Axes(1).ticklabels.NumberFormat = "General" ApExcel.ActiveChart.Axes(1).Select With ApExcel.ActiveChart.Axes(1) .MinimumScale = xminBueno .MaximumScale = xmaxBueno .MaximumScaleIsAuto = False .MinorUnitIsAuto = True .MajorUnitIsAuto = True End With ApExcel.ActiveChart.Axes(2).Select With ApExcel.ActiveChart.Axes(2) .MinimumScale = FAminBueno .MaximumScale = FAmaxBueno .MaximumScaleIsAuto = False .MinorUnitIsAuto = True .MajorUnitIsAuto = True .hasMajorGridlines = False End With With ApExcel.ActiveChart .HasTitle = False .Axes(1, 1).HasTitle = True .Axes(1, 1).AxisTitle.Characters.Text = "X (m)" .Axes(2, 1).HasTitle = True .Axes(2, 1).AxisTitle.Characters.Text = "FR" End With With ApExcel.ActiveChart.Axes(1) .MinimumScale = CSng(xminBueno) .MaximumScale = CSng(xmaxBueno) .MinorUnit = 10 .MajorUnit = 10 .Crosses = -4114 .CrossesAt = xminBueno .ReversePlotOrder = False .ScaleType = -4132 .DisplayUnit = -4142 End With ' Ponemos los limites de los ejes un poco mas adornados ApExcel.ActiveSheet.ChartObjects("Gráfico 2").Activate ApExcel.ActiveChart.ChartArea.Select ApExcel.ActiveChart.Axes(2).Select ApExcel.Selection.ticklabels.NumberFormat = "0.00" ApExcel.ActiveSheet.ChartObjects("Gráfico 1").Activate ApExcel.ActiveChart.ChartArea.Select ApExcel.ActiveSheet.Shapes("Gráfico 1").ScaleWidth 1.2, 0, 0 ApExcel.ActiveSheet.Shapes("Gráfico 1").ScaleHeight 1.68, 0, 0 ApExcel.ActiveSheet.ChartObjects("Gráfico 2").Activate ApExcel.ActiveChart.ChartArea.Select ApExcel.ActiveSheet.Shapes("Gráfico 2").ScaleWidth 1.2, 0, 0 ApExcel.ActiveSheet.Shapes("Gráfico 2").ScaleHeight 1.68, 0, 0 End If End Sub Sub PonlazosActivos() 'Ponemos ahora todos los lazos presentes en el proyecto, primero pasivos y luego activos i = 1 FilaLazo = FilaLazo + 3 ApExcel.cells(FilaLazo, 2) = "LAZOS ACTIVOS" ApExcel.cells(FilaLazo, 2).Select ApExcel.Selection.Font.Bold = True ' Colocamos cabeceras de simples FilaLazo = FilaLazo + 1 ApExcel.cells(FilaLazo, 2) = "Tipo" ApExcel.cells(FilaLazo, 3) = "X1 (m)" ApExcel.cells(FilaLazo, 4) = "Y1 (m)" ApExcel.cells(FilaLazo, 5) = "X2 (m)" ApExcel.cells(FilaLazo, 6) = "Y2 (m)" ApExcel.cells(FilaLazo, 7) = "X3 (m)" ApExcel.cells(FilaLazo, 8) = "Y3 (m)" ApExcel.cells(FilaLazo, 9) = "X4 (m)" ApExcel.cells(FilaLazo, 10) = "Y4 (m)" ApExcel.cells(FilaLazo, 11) = "Conductor" ApExcel.cells(FilaLazo, 12) = "R' (ohm/km)" ApExcel.cells(FilaLazo, 13) = "rgm (m)" ' Formato de la cabecera ApExcel.range("A" & CStr(FilaLazo) & ":P" & CStr(FilaLazo)).Select With ApExcel.Selection .HorizontalAlignment = -4108 End With If Module1.totalLazos > 0 Then While (i <= UBound(Module1.Lazos)) If Module1.Lazos(i).pasivo = False Then FilaLazo = FilaLazo + 1 If Module1.Lazos(i).Calcular = True Then esteLazo = i ' Si este es el lazo que se ha usado para resolver, añadimos su coste nombreConductor = Lazos(i).nombreConductor RConductor = Lazos(i).costeConductor rgmConductor = Lazos(i).rgmConductor costeConductor = Lazos(i).costeConductor nombrePoste = Lazos(i).nombreConductor alturaPoste = Lazos(i).alturaPoste costePoste = CStr(CSng(Lazos(i).costePoste)) ' El numero de postes vendra dado segun la configuracion Select Case Lazos(i).tipo Case Is = 2 numPostes = 4 Case Is = 3 numPostes = 6 Case Is = 4 numPostes = 8 End Select ApExcel.cells(FilaLazo, 1).Select With ApExcel.Selection.Interior .ColorIndex = 3 .Pattern = 1 End With End If If Module1.Lazos(i).tipo = "2" Then ApExcel.cells(FilaLazo, 2) = "Simple" ElseIf Module1.Lazos(i).tipo = "3" Then ApExcel.cells(FilaLazo, 2) = "Doble cond. común" Else ApExcel.cells(FilaLazo, 2) = "Doble" End If ApExcel.cells(FilaLazo, 3) = Module1.Lazos(i).x1 ApExcel.cells(FilaLazo, 4) = Module1.Lazos(i).y1 ApExcel.cells(FilaLazo, 5) = Module1.Lazos(i).x2 ApExcel.cells(FilaLazo, 6) = Module1.Lazos(i).y2 ApExcel.cells(FilaLazo, 11) = Module1.Lazos(i).nombreConductor ApExcel.cells(FilaLazo, 12) = CSng(Module1.Lazos(i).RConductor) ApExcel.cells(FilaLazo, 13) = CSng(Module1.Lazos(i).rgmConductor) If Module1.Lazos(i).tipo = "2" Then ApExcel.cells(FilaLazo, 7) = "N/A" ApExcel.cells(FilaLazo, 8) = "N/A" ApExcel.cells(FilaLazo, 9) = "N/A" ApExcel.cells(FilaLazo, 10) = "N/A" ElseIf Module1.Lazos(i).tipo = "3" Then ApExcel.cells(FilaLazo, 7) = Module1.Lazos(i).x3 ApExcel.cells(FilaLazo, 8) = Module1.Lazos(i).y3 ApExcel.cells(FilaLazo, 9) = "N/A" ApExcel.cells(FilaLazo, 10) = "N/A" Else ApExcel.cells(FilaLazo, 7) = Module1.Lazos(i).x3 ApExcel.cells(FilaLazo, 8) = Module1.Lazos(i).y3 ApExcel.cells(FilaLazo, 9) = Module1.Lazos(i).x4 ApExcel.cells(FilaLazo, 10) = Module1.Lazos(i).y4 End If End If i = i + 1 Wend End If End Sub Sub PutActiveLoops() 'Ponemos ahora todos los lazos presentes en el proyecto, primero pasivos y luego activos i = 1 FilaLazo = FilaLazo + 3 ApExcel.cells(FilaLazo, 2) = "ACTIVE LOOPS" ApExcel.cells(FilaLazo, 2).Select ApExcel.Selection.Font.Bold = True ' Colocamos cabeceras de simples FilaLazo = FilaLazo + 1 ApExcel.cells(FilaLazo, 2) = "Type" ApExcel.cells(FilaLazo, 3) = "X1 (m)" ApExcel.cells(FilaLazo, 4) = "Y1 (m)" ApExcel.cells(FilaLazo, 5) = "X2 (m)" ApExcel.cells(FilaLazo, 6) = "Y2 (m)" ApExcel.cells(FilaLazo, 7) = "X3 (m)" ApExcel.cells(FilaLazo, 8) = "Y3 (m)" ApExcel.cells(FilaLazo, 9) = "X4 (m)" ApExcel.cells(FilaLazo, 10) = "Y4 (m)" ApExcel.cells(FilaLazo, 11) = "Conductor" ApExcel.cells(FilaLazo, 12) = "R' (ohm/km)" ApExcel.cells(FilaLazo, 13) = "rgm (m)" ' Formato de la cabecera ApExcel.range("A" & CStr(FilaLazo) & ":P" & CStr(FilaLazo)).Select With ApExcel.Selection .HorizontalAlignment = -4108 End With If Module1.totalLazos > 0 Then While (i <= UBound(Module1.Lazos)) If Module1.Lazos(i).pasivo = False Then FilaLazo = FilaLazo + 1 If Module1.Lazos(i).Calcular = True Then esteLazo = i ' Si este es el lazo que se ha usado para resolver, añadimos su coste nombreConductor = Lazos(i).nombreConductor RConductor = Lazos(i).costeConductor rgmConductor = Lazos(i).rgmConductor costeConductor = Lazos(i).costeConductor nombrePoste = Lazos(i).nombreConductor alturaPoste = Lazos(i).alturaPoste costePoste = CStr(CSng(Lazos(i).costePoste)) ' El numero de postes vendra dado segun la configuracion Select Case Lazos(i).tipo Case Is = 2 numPostes = 4 Case Is = 3 numPostes = 6 Case Is = 4 numPostes = 8 End Select ApExcel.cells(FilaLazo, 1).Select With ApExcel.Selection.Interior .ColorIndex = 3 .Pattern = 1 End With End If If Module1.Lazos(i).tipo = "2" Then ApExcel.cells(FilaLazo, 2) = "Simple" ElseIf Module1.Lazos(i).tipo = "3" Then ApExcel.cells(FilaLazo, 2) = "Double common cond." Else ApExcel.cells(FilaLazo, 2) = "Double" End If ApExcel.cells(FilaLazo, 3) = Module1.Lazos(i).x1 ApExcel.cells(FilaLazo, 4) = Module1.Lazos(i).y1 ApExcel.cells(FilaLazo, 5) = Module1.Lazos(i).x2 ApExcel.cells(FilaLazo, 6) = Module1.Lazos(i).y2 ApExcel.cells(FilaLazo, 11) = Module1.Lazos(i).nombreConductor ApExcel.cells(FilaLazo, 12) = CSng(Module1.Lazos(i).RConductor) ApExcel.cells(FilaLazo, 13) = CSng(Module1.Lazos(i).rgmConductor) If Module1.Lazos(i).tipo = "2" Then ApExcel.cells(FilaLazo, 7) = "N/A" ApExcel.cells(FilaLazo, 8) = "N/A" ApExcel.cells(FilaLazo, 9) = "N/A" ApExcel.cells(FilaLazo, 10) = "N/A" ElseIf Module1.Lazos(i).tipo = "3" Then ApExcel.cells(FilaLazo, 7) = Module1.Lazos(i).x3 ApExcel.cells(FilaLazo, 8) = Module1.Lazos(i).y3 ApExcel.cells(FilaLazo, 9) = "N/A" ApExcel.cells(FilaLazo, 10) = "N/A" Else ApExcel.cells(FilaLazo, 7) = Module1.Lazos(i).x3 ApExcel.cells(FilaLazo, 8) = Module1.Lazos(i).y3 ApExcel.cells(FilaLazo, 9) = Module1.Lazos(i).x4 ApExcel.cells(FilaLazo, 10) = Module1.Lazos(i).y4 End If End If i = i + 1 Wend End If End Sub Sub PonlazosPasivos() 'Ponemos ahora todos los lazos presentes en el proyecto, primero pasivos y luego activos i = 1 FilaLazo = filaObstac + 3 ApExcel.cells(FilaLazo, 2) = "LAZOS PASIVOS" ApExcel.cells(FilaLazo, 2).Select ApExcel.Selection.Font.Bold = True 'Colocamos cabeceras de simples FilaLazo = FilaLazo + 1 ApExcel.cells(FilaLazo, 2) = "Tipo" ApExcel.cells(FilaLazo, 3) = "X1 (m)" ApExcel.cells(FilaLazo, 4) = "Y1 (m)" ApExcel.cells(FilaLazo, 5) = "X2 (m)" ApExcel.cells(FilaLazo, 6) = "Y2 (m)" ApExcel.cells(FilaLazo, 7) = "X3 (m)" ApExcel.cells(FilaLazo, 8) = "Y3 (m)" ApExcel.cells(FilaLazo, 9) = "X4 (m)" ApExcel.cells(FilaLazo, 10) = "Y4 (m)" ApExcel.cells(FilaLazo, 11) = "Conductor" ApExcel.cells(FilaLazo, 12) = "R' (ohm/km)" ApExcel.cells(FilaLazo, 13) = "rgm (m)" ApExcel.range("A" & CStr(FilaLazo) & ":P" & CStr(FilaLazo)).Select With ApExcel.Selection .HorizontalAlignment = -4108 End With If Module1.totalLazos > 0 Then While (i <= UBound(Module1.Lazos)) If Module1.Lazos(i).pasivo = True Then FilaLazo = FilaLazo + 1 If Module1.Lazos(i).Calcular = True Then esteLazo = i ApExcel.cells(FilaLazo, 1).Select With ApExcel.Selection.Interior .ColorIndex = 3 .Pattern = 1 End With End If If Module1.Lazos(i).tipo = "2" Then ApExcel.cells(FilaLazo, 2) = "Simple" ElseIf Module1.Lazos(i).tipo = "3" Then ApExcel.cells(FilaLazo, 2) = "Doble cond. común" Else ApExcel.cells(FilaLazo, 2) = "Doble" End If ApExcel.cells(FilaLazo, 3) = Module1.Lazos(i).x1 ApExcel.cells(FilaLazo, 4) = Module1.Lazos(i).y1 ApExcel.cells(FilaLazo, 5) = Module1.Lazos(i).x2 ApExcel.cells(FilaLazo, 6) = Module1.Lazos(i).y2 ApExcel.cells(FilaLazo, 11) = Module1.Lazos(i).nombreConductor ApExcel.cells(FilaLazo, 12) = CSng(Module1.Lazos(i).RConductor) ApExcel.cells(FilaLazo, 13) = CSng(Module1.Lazos(i).rgmConductor) If Module1.Lazos(i).tipo = "2" Then ApExcel.cells(FilaLazo, 7) = "N/A" ApExcel.cells(FilaLazo, 8) = "N/A" ApExcel.cells(FilaLazo, 9) = "N/A" ApExcel.cells(FilaLazo, 10) = "N/A" ElseIf Module1.Lazos(i).tipo = "3" Then ApExcel.cells(FilaLazo, 7) = CSng(Module1.Lazos(i).x3) ApExcel.cells(FilaLazo, 8) = CSng(Module1.Lazos(i).y3) ApExcel.cells(FilaLazo, 9) = "N/A" ApExcel.cells(FilaLazo, 10) = "N/A" Else ApExcel.cells(FilaLazo, 7) = Module1.Lazos(i).x3 ApExcel.cells(FilaLazo, 8) = Module1.Lazos(i).y3 ApExcel.cells(FilaLazo, 9) = Module1.Lazos(i).x4 ApExcel.cells(FilaLazo, 10) = Module1.Lazos(i).y4 End If End If i = i + 1 Wend End If End Sub Sub PutPassiveLoops() 'Ponemos ahora todos los lazos presentes en el proyecto, primero pasivos y luego activos i = 1 FilaLazo = filaObstac + 3 ApExcel.cells(FilaLazo, 2) = "PASSIVE LOOPS" ApExcel.cells(FilaLazo, 2).Select ApExcel.Selection.Font.Bold = True 'Colocamos cabeceras de simples FilaLazo = FilaLazo + 1 ApExcel.cells(FilaLazo, 2) = "Type" ApExcel.cells(FilaLazo, 3) = "X1 (m)" ApExcel.cells(FilaLazo, 4) = "Y1 (m)" ApExcel.cells(FilaLazo, 5) = "X2 (m)" ApExcel.cells(FilaLazo, 6) = "Y2 (m)" ApExcel.cells(FilaLazo, 7) = "X3 (m)" ApExcel.cells(FilaLazo, 8) = "Y3 (m)" ApExcel.cells(FilaLazo, 9) = "X4 (m)" ApExcel.cells(FilaLazo, 10) = "Y4 (m)" ApExcel.cells(FilaLazo, 11) = "Conductor" ApExcel.cells(FilaLazo, 12) = "R' (ohm/km)" ApExcel.cells(FilaLazo, 13) = "rgm (m)" ApExcel.range("A" & CStr(FilaLazo) & ":P" & CStr(FilaLazo)).Select With ApExcel.Selection .HorizontalAlignment = -4108 End With If Module1.totalLazos > 0 Then While (i <= UBound(Module1.Lazos)) If Module1.Lazos(i).pasivo = True Then FilaLazo = FilaLazo + 1 If Module1.Lazos(i).Calcular = True Then esteLazo = i ApExcel.cells(FilaLazo, 1).Select With ApExcel.Selection.Interior .ColorIndex = 3 .Pattern = 1 End With End If If Module1.Lazos(i).tipo = "2" Then ApExcel.cells(FilaLazo, 2) = "Simple" ElseIf Module1.Lazos(i).tipo = "3" Then ApExcel.cells(FilaLazo, 2) = "Double, common cond." Else ApExcel.cells(FilaLazo, 2) = "Double" End If ApExcel.cells(FilaLazo, 3) = Module1.Lazos(i).x1 ApExcel.cells(FilaLazo, 4) = Module1.Lazos(i).y1 ApExcel.cells(FilaLazo, 5) = Module1.Lazos(i).x2 ApExcel.cells(FilaLazo, 6) = Module1.Lazos(i).y2 ApExcel.cells(FilaLazo, 11) = Module1.Lazos(i).nombreConductor ApExcel.cells(FilaLazo, 12) = CSng(Module1.Lazos(i).RConductor) ApExcel.cells(FilaLazo, 13) = CSng(Module1.Lazos(i).rgmConductor) If Module1.Lazos(i).tipo = "2" Then ApExcel.cells(FilaLazo, 7) = "N/A" ApExcel.cells(FilaLazo, 8) = "N/A" ApExcel.cells(FilaLazo, 9) = "N/A" ApExcel.cells(FilaLazo, 10) = "N/A" ElseIf Module1.Lazos(i).tipo = "3" Then ApExcel.cells(FilaLazo, 7) = CSng(Module1.Lazos(i).x3) ApExcel.cells(FilaLazo, 8) = CSng(Module1.Lazos(i).y3) ApExcel.cells(FilaLazo, 9) = "N/A" ApExcel.cells(FilaLazo, 10) = "N/A" Else ApExcel.cells(FilaLazo, 7) = Module1.Lazos(i).x3 ApExcel.cells(FilaLazo, 8) = Module1.Lazos(i).y3 ApExcel.cells(FilaLazo, 9) = Module1.Lazos(i).x4 ApExcel.cells(FilaLazo, 10) = Module1.Lazos(i).y4 End If End If i = i + 1 Wend End If End Sub Sub PonObstaculos() ' Calculamos la primera fila disponible If filalin1 > filalin2 Then filaObstac = filalin1 Else filaObstac = filalin2 End If filaObstac = filaObstac + 2 ApExcel.cells(filaObstac, 2) = "Restricciones" ApExcel.cells(filaObstac, 2).Select ApExcel.Selection.Font.Bold = True ApExcel.range("C" & CStr(filaObstac) & ":F" & CStr(filaObstac)).Select ApExcel.Selection.merge ApExcel.cells(filaObstac, 3).formula = "Cuerpo" With ApExcel.Selection .HorizontalAlignment = -4108 End With ApExcel.range("G" & CStr(filaObstac) & ":J" & CStr(filaObstac)).Select ApExcel.Selection.merge ApExcel.cells(filaObstac, 7).formula = "Zona prohibida" With ApExcel.Selection .HorizontalAlignment = -4108 End With ' Colocamos cabeceras filaObstac = filaObstac + 1 ApExcel.cells(filaObstac, 2) = "Tipo" ApExcel.cells(filaObstac, 3) = "Xmim (m)" ApExcel.cells(filaObstac, 4) = "Xmax (m)" ApExcel.cells(filaObstac, 5) = "Ymin (m)" ApExcel.cells(filaObstac, 6) = "Ymax (m)" ApExcel.cells(filaObstac, 7) = "Xmin (m)" ApExcel.cells(filaObstac, 8) = "Xmax (m)" ApExcel.cells(filaObstac, 9) = "Ymin (m)" ApExcel.cells(filaObstac, 10) = "Ymax (m)" ApExcel.range("C" & CStr(filaObstac) & ":Z" & CStr(filaObstac)).Select With ApExcel.Selection .HorizontalAlignment = -4108 End With ' Comenzamos por líneas horizontales i = 1 If Module1.totalLineasHorizontales > 0 Then While (i <= UBound(LineasHorizontales)) filaObstac = filaObstac + 1 ApExcel.cells(filaObstac, 2) = "Restricción Horizontal" ApExcel.cells(filaObstac, 3) = "N/A" ApExcel.cells(filaObstac, 4) = "N/A" ApExcel.cells(filaObstac, 5) = "N/A" ApExcel.cells(filaObstac, 6) = "N/A" ApExcel.cells(filaObstac, 7) = "N/A" ApExcel.cells(filaObstac, 8) = "N/A" ApExcel.cells(filaObstac, 9) = "0" ApExcel.cells(filaObstac, 10) = LineasHorizontales(i).altura i = i + 1 Wend End If ' Ahora obstáculos normales i = 1 If Module1.totalnorm > 0 Then While (i <= UBound(Module1.NormalesPictureBox)) filaObstac = filaObstac + 1 ApExcel.cells(filaObstac, 2) = "Obstáculo Normal" ApExcel.cells(filaObstac, 3) = Module1.NormalesPictureBox(i).coordx ApExcel.cells(filaObstac, 4) = Module1.NormalesPictureBox(i).coordx + _ Module1.NormalesPictureBox(i).anchura ApExcel.cells(filaObstac, 5) = "0" ApExcel.cells(filaObstac, 6) = Module1.NormalesPictureBox(i).altura ApExcel.cells(filaObstac, 7) = Module1.NormalesPictureBox(i).coordx - _ Module1.NormalesPictureBox(i).izquierda ApExcel.cells(filaObstac, 8) = Module1.NormalesPictureBox(i).coordx + _ Module1.NormalesPictureBox(i).anchura + Module1.NormalesPictureBox(i).derecha ApExcel.cells(filaObstac, 9) = "0" ApExcel.cells(filaObstac, 10) = Module1.NormalesPictureBox(i).altura + _ Module1.NormalesPictureBox(i).arriba i = i + 1 Wend End If ' Ahora obstáculos elevados tipo I y II i = 1 If Module1.totalelevados > 0 Then While (i <= UBound(Module1.ElevadosPictureBox)) filaObstac = filaObstac + 1 If Module1.ElevadosPictureBox(i).apoyado = True Then ApExcel.cells(filaObstac, 2).formula = "Obstáculo elevado tipo I" Else ApExcel.cells(filaObstac, 2) = "Obstáculo elevado tipo II" End If ApExcel.cells(filaObstac, 3) = Module1.ElevadosPictureBox(i).coordx ApExcel.cells(filaObstac, 4) = Module1.ElevadosPictureBox(i).coordx + _ Module1.ElevadosPictureBox(i).anchura ApExcel.cells(filaObstac, 5) = Module1.ElevadosPictureBox(i).distanciaAlSuelo + _ Module1.ElevadosPictureBox(i).inferior ApExcel.cells(filaObstac, 6) = Module1.ElevadosPictureBox(i).altura + _ Module1.ElevadosPictureBox(i).distanciaAlSuelo + Module1.ElevadosPictureBox(i).inferior ApExcel.cells(filaObstac, 7) = Module1.ElevadosPictureBox(i).coordx - _ Module1.ElevadosPictureBox(i).izda ApExcel.cells(filaObstac, 8) = Module1.ElevadosPictureBox(i).coordx + _ Module1.ElevadosPictureBox(i).anchura + Module1.ElevadosPictureBox(i).dcha ApExcel.cells(filaObstac, 9) = Module1.ElevadosPictureBox(i).coordx - _ Module1.ElevadosPictureBox(i).inferior - Module1.ElevadosPictureBox(i).distanciaAlSuelo ApExcel.cells(filaObstac, 10) = Module1.ElevadosPictureBox(i).altura + _ Module1.ElevadosPictureBox(i).alturaprohibida i = i + 1 Wend End If End Sub Sub PutObstacles() ' Calculamos la primera fila disponible If filalin1 > filalin2 Then filaObstac = filalin1 Else filaObstac = filalin2 End If filaObstac = filaObstac + 2 ApExcel.cells(filaObstac, 2) = "Obstacles" ApExcel.cells(filaObstac, 2).Select ApExcel.Selection.Font.Bold = True ' Colocamos cabeceras filaObstac = filaObstac + 1 ApExcel.cells(filaObstac, 2) = "Type" ApExcel.cells(filaObstac, 3) = "Body Xm (m)" ApExcel.cells(filaObstac, 4) = "Body XM (m)" ApExcel.cells(filaObstac, 5) = "Body Ym (m)" ApExcel.cells(filaObstac, 6) = "Body YM (m)" ApExcel.cells(filaObstac, 7) = "Forbidden Area Xm (m)" ApExcel.cells(filaObstac, 8) = "Forbidden Area XM (m)" ApExcel.cells(filaObstac, 9) = "Forbidden Area Ym (m)" ApExcel.cells(filaObstac, 10) = "Forbidden Area YM (m)" ' Comenzamos por líneas horizontales i = 1 If Module1.totalLineasHorizontales > 0 Then While (i <= UBound(LineasHorizontales)) filaObstac = filaObstac + 1 ApExcel.cells(filaObstac, 2) = "Horizontal Restriction" ApExcel.cells(filaObstac, 3) = "N/A" ApExcel.cells(filaObstac, 4) = "N/A" ApExcel.cells(filaObstac, 5) = "N/A" ApExcel.cells(filaObstac, 6) = "N/A" ApExcel.cells(filaObstac, 7) = "N/A" ApExcel.cells(filaObstac, 8) = "N/A" ApExcel.cells(filaObstac, 9) = "0" ApExcel.cells(filaObstac, 10) = LineasHorizontales(i).altura i = i + 1 Wend End If ' Ahora obstáculos normales i = 1 If Module1.totalnorm > 0 Then While (i <= UBound(Module1.NormalesPictureBox)) filaObstac = filaObstac + 1 ApExcel.cells(filaObstac, 2) = "Normal Obstacle" ApExcel.cells(filaObstac, 3) = Module1.NormalesPictureBox(i).coordx ApExcel.cells(filaObstac, 4) = Module1.NormalesPictureBox(i).coordx + _ Module1.NormalesPictureBox(i).anchura ApExcel.cells(filaObstac, 5) = "0" ApExcel.cells(filaObstac, 6) = Module1.NormalesPictureBox(i).altura ApExcel.cells(filaObstac, 7) = Module1.NormalesPictureBox(i).coordx - _ Module1.NormalesPictureBox(i).izquierda ApExcel.cells(filaObstac, 8) = Module1.NormalesPictureBox(i).coordx + _ Module1.NormalesPictureBox(i).anchura + Module1.NormalesPictureBox(i).derecha ApExcel.cells(filaObstac, 9) = "0" ApExcel.cells(filaObstac, 10) = Module1.NormalesPictureBox(i).altura + _ Module1.NormalesPictureBox(i).arriba i = i + 1 Wend End If ' Ahora obstáculos elevados tipo I y II i = 1 If Module1.totalelevados > 0 Then While (i <= UBound(Module1.ElevadosPictureBox)) filaObstac = filaObstac + 1 If Module1.ElevadosPictureBox(i).apoyado = True Then ApExcel.cells(filaObstac, 2).formula = "Type I Lifted Obstacle" Else ApExcel.cells(filaObstac, 2) = "Type II Lifted Obstacle" End If ApExcel.cells(filaObstac, 3) = Module1.ElevadosPictureBox(i).coordx ApExcel.cells(filaObstac, 4) = Module1.ElevadosPictureBox(i).coordx + _ Module1.ElevadosPictureBox(i).anchura ApExcel.cells(filaObstac, 5) = Module1.ElevadosPictureBox(i).distanciaAlSuelo + _ Module1.ElevadosPictureBox(i).inferior ApExcel.cells(filaObstac, 6) = Module1.ElevadosPictureBox(i).altura + _ Module1.ElevadosPictureBox(i).distanciaAlSuelo + Module1.ElevadosPictureBox(i).inferior ApExcel.cells(filaObstac, 7) = Module1.ElevadosPictureBox(i).coordx - _ Module1.ElevadosPictureBox(i).izda ApExcel.cells(filaObstac, 8) = Module1.ElevadosPictureBox(i).coordx + _ Module1.ElevadosPictureBox(i).anchura + Module1.ElevadosPictureBox(i).dcha ApExcel.cells(filaObstac, 9) = Module1.ElevadosPictureBox(i).coordx - _ Module1.ElevadosPictureBox(i).inferior - Module1.ElevadosPictureBox(i).distanciaAlSuelo ApExcel.cells(filaObstac, 10) = Module1.ElevadosPictureBox(i).altura + _ Module1.ElevadosPictureBox(i).alturaprohibida i = i + 1 Wend End If End Sub Sub PonLineas() ' Nombre de la hoja ApExcel.sheets("Hoja1").Select ApExcel.sheets("Hoja1").Name = "Configuración" ' Ahora los cabeceras de datos de las líneas filalin1 = filaGeneral + 3 filalin2 = filaGeneral + 3 ApExcel.cells(filalin1, 2).formula = "LINEAS" ApExcel.cells(filalin1, 2).Select ApExcel.Selection.Font.Bold = True filalin1 = filalin1 + 1 filalin2 = filalin2 + 1 ' Datos Linea 1 ApExcel.cells(filalin1, 2).formula = "Línea 1:" filalin1 = filalin1 + 1 ApExcel.cells(filalin1, 3).formula = "x(m)" ApExcel.cells(filalin1, 4).formula = "y (m)" ApExcel.cells(filalin1, 5).formula = "I fase(A, RMS)" ApExcel.cells(filalin1, 6).formula = "theta (º)" ApExcel.cells(filalin2, 8).formula = "Línea 2:" filalin2 = filalin2 + 1 ApExcel.cells(filalin2, 9).formula = "x (m)" ApExcel.cells(filalin2, 10).formula = "y (m)" ApExcel.cells(filalin2, 11).formula = "I fase(A,RMS)" ApExcel.cells(filalin2, 12).formula = "theta (º)" ApExcel.range("C11:M11").Select With ApExcel.Selection .HorizontalAlignment = -4108 End With ' Vamos recorriendo los elementos presentes en las diversas configuraciones ' y ponemos la descripción apropiada junto con los datos. ' Fases simplex If Module1.totalcond > 0 Then i = 1 While (i <= UBound(Module1.conductoresPictureBox)) If Module1.conductoresPictureBox(i).linea = 1 Then filalin1 = filalin1 + 1 ApExcel.cells(filalin1, 2) = "Fase símplex" ponEnExcel filalin1, 3, conductoresPictureBox(i).coordx ponEnExcel filalin1, 4, conductoresPictureBox(i).altura ponEnExcel filalin1, 5, conductoresPictureBox(i).intensidad ponEnExcel filalin1, 6, conductoresPictureBox(i).desfase Else filalin2 = filalin2 + 1 ApExcel.cells(filalin1, 8) = "Fase símplex" ponEnExcel filalin2, 9, conductoresPictureBox(i).coordx ponEnExcel filalin2, 10, conductoresPictureBox(i).altura ponEnExcel filalin2, 11, conductoresPictureBox(i).intensidad ponEnExcel filalin2, 12, conductoresPictureBox(i).desfase End If i = i + 1 Wend End If ' Fases dúplex If Module1.totalcondmultiples > 0 Then i = 1 While (i <= UBound(Module1.conductoresMultiples)) If Module1.conductoresMultiples(i).linea = 1 Then filalin1 = filalin1 + 1 ApExcel.cells(filalin1, 2) = "Fase dúplex" ponEnExcel filalin1, 3, conductoresMultiples(i).coordx ponEnExcel filalin1, 4, conductoresMultiples(i).coordy ponEnExcel filalin1, 5, conductoresMultiples(i).intensidad1 ponEnExcel filalin1, 6, conductoresMultiples(i).desfase1 ' Si es horizontal la separacion se le suma a la x, si no a la y If Module1.conductoresMultiples(i).tipo = "2condhoriz" Then filalin1 = filalin1 + 1 ponEnExcel filalin1, 3, conductoresMultiples(i).coordx + _ conductoresMultiples(i).separacion ponEnExcel filalin1, 4, conductoresMultiples(i).coordy ponEnExcel filalin1, 5, conductoresMultiples(i).intensidad1 ponEnExcel filalin1, 6, conductoresMultiples(i).desfase1 Else filalin1 = filalin1 + 1 ponEnExcel filalin1, 3, conductoresMultiples(i).coordx ponEnExcel filalin1, 4, conductoresMultiples(i).coordy + _ conductoresMultiples(i).separacion ponEnExcel filalin1, 5, conductoresMultiples(i).intensidad1 ponEnExcel filalin1, 6, conductoresMultiples(i).desfase1 End If Else filalin2 = filalin2 + 1 ApExcel.cells(filalin2, 8) = "Fase dúplex" ponEnExcel filalin2, 9, conductoresMultiples(i).coordx ponEnExcel filalin2, 10, conductoresMultiples(i).coordy ponEnExcel filalin2, 11, conductoresMultiples(i).intensidad1 ponEnExcel filalin2, 12, conductoresMultiples(i).desfase1 ' Si es horizontal la separacion se le suma a la x, si no a la y If Module1.conductoresMultiples(i).tipo = "2condhoriz" Then filalin2 = filalin2 + 1 ponEnExcel filalin2, 9, conductoresMultiples(i).coordx + _ conductoresMultiples(i).separacion ponEnExcel filalin2, 10, conductoresMultiples(i).coordy ponEnExcel filalin2, 11, conductoresMultiples(i).intensidad1 ponEnExcel filalin2, 12, conductoresMultiples(i).desfase1 Else filalin2 = filalin2 + 1 ponEnExcel filalin2, 9, conductoresMultiples(i).coordx ponEnExcel filalin2, 10, conductoresMultiples(i).coordy + _ conductoresMultiples(i).separacion ponEnExcel filalin2, 11, conductoresMultiples(i).intensidad1 ponEnExcel filalin2, 12, conductoresMultiples(i).desfase1 End If End If i = i + 1 Wend End If ' Fases tríplex If Module1.total3cond > 0 Then i = 1 While (i <= UBound(Module1.tresConductores)) If Module1.tresConductores(i).linea = 1 Then filalin1 = filalin1 + 1 ApExcel.cells(filalin1, 2) = "Fase Tríplex" ponEnExcel filalin1, 3, tresConductores(i).coordx ponEnExcel filalin1, 4, tresConductores(i).coordy ponEnExcel filalin1, 5, tresConductores(i).intensidad ponEnExcel filalin1, 6, tresConductores(i).desfase ' Si es tipo I If Module1.tresConductores(i).unoarriba = True Then filalin1 = filalin1 + 1 ponEnExcel filalin1, 3, tresConductores(i).coordx + _ tresConductores(i).d ponEnExcel filalin1, 4, tresConductores(i).coordy ponEnExcel filalin1, 5, tresConductores(i).intensidad ponEnExcel filalin1, 6, tresConductores(i).desfase filalin1 = filalin1 + 1 ponEnExcel filalin1, 3, tresConductores(i).coordx + _ tresConductores(i).d / 2 ponEnExcel filalin1, 4, tresConductores(i).coordy + _ tresConductores(i).h ponEnExcel filalin1, 5, tresConductores(i).intensidad ponEnExcel filalin1, 6, tresConductores(i).desfase Else filalin1 = filalin1 + 1 ponEnExcel filalin1, 3, tresConductores(i).coordx + _ tresConductores(i).d ponEnExcel filalin1, 4, tresConductores(i).coordy ponEnExcel filalin1, 5, tresConductores(i).intensidad ponEnExcel filalin1, 6, tresConductores(i).desfase filalin1 = filalin1 + 1 ponEnExcel filalin1, 3, tresConductores(i).coordx + _ tresConductores(i).d / 2 ponEnExcel filalin1, 4, tresConductores(i).coordy + _ tresConductores(i).h ponEnExcel filalin1, 5, tresConductores(i).intensidad ponEnExcel filalin1, 6, tresConductores(i).desfase End If Else filalin2 = filalin2 + 1 ApExcel.cells(filalin1, 8) = "Fase tríplex" ponEnExcel filalin2, 9, tresConductores(i).coordx ponEnExcel filalin2, 10, tresConductores(i).coordy ponEnExcel filalin2, 11, tresConductores(i).intensidad ponEnExcel filalin2, 12, tresConductores(i).desfase ' Si es tipo I If Module1.tresConductores(i).unoarriba = True Then filalin2 = filalin2 + 1 ponEnExcel filalin2, 9, tresConductores(i).coordx + _ tresConductores(i).d ponEnExcel filalin2, 10, tresConductores(i).coordy ponEnExcel filalin2, 11, tresConductores(i).intensidad ponEnExcel filalin2, 12, tresConductores(i).desfase filalin2 = filalin2 + 1 ponEnExcel filalin2, 9, tresConductores(i).coordx + _ tresConductores(i).d / 2 ponEnExcel filalin2, 10, tresConductores(i).coordy + _ tresConductores(i).h ponEnExcel filalin2, 11, tresConductores(i).intensidad ponEnExcel filalin2, 12, tresConductores(i).desfase Else filalin2 = filalin2 + 1 ponEnExcel filalin2, 9, tresConductores(i).coordx + _ tresConductores(i).d ponEnExcel filalin2, 10, tresConductores(i).coordy ponEnExcel filalin2, 11, tresConductores(i).intensidad ponEnExcel filalin2, 12, tresConductores(i).desfase filalin2 = filalin2 + 1 ponEnExcel filalin2, 9, tresConductores(i).coordx + _ tresConductores(i).d / 2 ponEnExcel filalin2, 10, tresConductores(i).coordy + _ tresConductores(i).h ponEnExcel filalin2, 11, tresConductores(i).intensidad ponEnExcel filalin2, 12, tresConductores(i).desfase End If End If i = i + 1 Wend End If ' Fases cuádruplex If Module1.total4cond > 0 Then i = 1 While (i <= UBound(Module1.cuatroConductores)) If Module1.cuatroConductores(i).linea = 1 Then filalin1 = filalin1 + 1 ApExcel.cells(filalin1, 2) = "Fase cuádruplex" ponEnExcel filalin1, 3, cuatroConductores(i).coordx ponEnExcel filalin1, 4, cuatroConductores(i).coordy ponEnExcel filalin1, 5, cuatroConductores(i).intensidad1 ponEnExcel filalin1, 6, cuatroConductores(i).desfase1 filalin1 = filalin1 + 1 ponEnExcel filalin1, 3, cuatroConductores(i).coordx + _ cuatroConductores(i).disth ponEnExcel filalin1, 4, cuatroConductores(i).coordy ponEnExcel filalin1, 5, cuatroConductores(i).intensidad1 ponEnExcel filalin1, 6, cuatroConductores(i).desfase1 filalin1 = filalin1 + 1 ponEnExcel filalin1, 3, cuatroConductores(i).coordx + _ cuatroConductores(i).disth ponEnExcel filalin1, 4, cuatroConductores(i).coordy + _ cuatroConductores(i).distv ponEnExcel filalin1, 5, cuatroConductores(i).intensidad1 ponEnExcel filalin1, 6, cuatroConductores(i).desfase1 filalin1 = filalin1 + 1 ponEnExcel filalin1, 3, cuatroConductores(i).coordx ponEnExcel filalin1, 4, cuatroConductores(i).coordy + _ cuatroConductores(i).disth ponEnExcel filalin1, 5, cuatroConductores(i).intensidad1 ponEnExcel filalin1, 6, cuatroConductores(i).desfase1 Else filalin2 = filalin2 + 1 ApExcel.cells(filalin1, 8) = "Fase cuádruplex" ponEnExcel filalin2, 9, cuatroConductores(i).coordx ponEnExcel filalin2, 10, cuatroConductores(i).coordy ponEnExcel filalin2, 11, cuatroConductores(i).intensidad1 ponEnExcel filalin2, 12, cuatroConductores(i).desfase1 filalin2 = filalin2 + 1 ponEnExcel filalin2, 9, cuatroConductores(i).coordx + _ cuatroConductores(i).disth ponEnExcel filalin2, 10, cuatroConductores(i).coordy ponEnExcel filalin2, 11, cuatroConductores(i).intensidad1 ponEnExcel filalin2, 12, cuatroConductores(i).desfase1 filalin2 = filalin2 + 1 ponEnExcel filalin2, 9, cuatroConductores(i).coordx ponEnExcel filalin2, 10, cuatroConductores(i).coordy + _ cuatroConductores(i).distv ponEnExcel filalin2, 11, cuatroConductores(i).intensidad1 ponEnExcel filalin2, 12, cuatroConductores(i).desfase1 filalin2 = filalin2 + 1 ponEnExcel filalin2, 9, cuatroConductores(i).coordx + _ cuatroConductores(i).disth ponEnExcel filalin2, 10, cuatroConductores(i).coordy + _ cuatroConductores(i).distv ponEnExcel filalin2, 11, cuatroConductores(i).intensidad1 ponEnExcel filalin2, 12, cuatroConductores(i).desfase1 End If i = i + 1 Wend End If End Sub Sub PutLines() ' Nombre de la hoja ApExcel.sheets("Hoja1").Select ApExcel.sheets("Hoja1").Name = "Configuration" ' Ahora los cabeceras de datos de las líneas filalin1 = filaGeneral + 3 filalin2 = filaGeneral + 3 ApExcel.cells(filalin1, 2).formula = "LINES" ApExcel.cells(filalin1, 2).Select ApExcel.Selection.Font.Bold = True filalin1 = filalin1 + 1 filalin2 = filalin2 + 1 ApExcel.cells(filalin1, 2).formula = "Line 1:" filalin1 = filalin1 + 1 ApExcel.cells(filalin1, 3).formula = "x(m)" ApExcel.cells(filalin1, 4).formula = "y (m)" ApExcel.cells(filalin1, 5).formula = "Phase I (A, RMS)" ApExcel.cells(filalin1, 6).formula = "theta (º)" ApExcel.cells(filalin2, 8).formula = "Line 2:" filalin2 = filalin2 + 1 ApExcel.cells(filalin2, 9).formula = "x (m)" ApExcel.cells(filalin2, 10).formula = "y (m)" ApExcel.cells(filalin2, 11).formula = "Phase I (A,RMS)" ApExcel.cells(filalin2, 12).formula = "theta (º)" ApExcel.range("C10:M10").Select With ApExcel.Selection .HorizontalAlignment = -4108 End With ' Vamos recorriendo los elementos presentes en las diversas configuraciones ' y ponemos la descripción apropiada junto con los datos. ' Fases simplex If Module1.totalcond > 0 Then i = 1 While (i <= UBound(Module1.conductoresPictureBox)) If Module1.conductoresPictureBox(i).linea = 1 Then filalin1 = filalin1 + 1 ApExcel.cells(filalin1, 2) = "Simplex Phase" ponEnExcel filalin1, 3, conductoresPictureBox(i).coordx ponEnExcel filalin1, 4, conductoresPictureBox(i).altura ponEnExcel filalin1, 5, conductoresPictureBox(i).intensidad ponEnExcel filalin1, 6, conductoresPictureBox(i).desfase Else filalin2 = filalin2 + 1 ApExcel.cells(filalin1, 8) = "Simplex Phase" ponEnExcel filalin2, 9, conductoresPictureBox(i).coordx ponEnExcel filalin2, 10, conductoresPictureBox(i).altura ponEnExcel filalin2, 11, conductoresPictureBox(i).intensidad ponEnExcel filalin2, 12, conductoresPictureBox(i).desfase End If i = i + 1 Wend End If ' Fases dúplex If Module1.totalcondmultiples > 0 Then i = 1 While (i <= UBound(Module1.conductoresMultiples)) If Module1.conductoresMultiples(i).linea = 1 Then filalin1 = filalin1 + 1 ApExcel.cells(filalin1, 2) = "Dúplex Phase" ponEnExcel filalin1, 3, conductoresMultiples(i).coordx ponEnExcel filalin1, 4, conductoresMultiples(i).coordy ponEnExcel filalin1, 5, conductoresMultiples(i).intensidad1 ponEnExcel filalin1, 6, conductoresMultiples(i).desfase1 ' Si es horizontal la separacion se le suma a la x, si no a la y If Module1.conductoresMultiples(i).tipo = "2condhoriz" Then filalin1 = filalin1 + 1 ponEnExcel filalin1, 3, conductoresMultiples(i).coordx + _ conductoresMultiples(i).separacion ponEnExcel filalin1, 4, conductoresMultiples(i).coordy ponEnExcel filalin1, 5, conductoresMultiples(i).intensidad1 ponEnExcel filalin1, 6, conductoresMultiples(i).desfase1 Else filalin1 = filalin1 + 1 ponEnExcel filalin1, 3, conductoresMultiples(i).coordx ponEnExcel filalin1, 4, conductoresMultiples(i).coordy + _ conductoresMultiples(i).separacion ponEnExcel filalin1, 5, conductoresMultiples(i).intensidad1 ponEnExcel filalin1, 6, conductoresMultiples(i).desfase1 End If Else filalin2 = filalin2 + 1 ApExcel.cells(filalin1, 8) = "Duplex Phase" ponEnExcel filalin2, 9, conductoresMultiples(i).coordx ponEnExcel filalin2, 10, conductoresMultiples(i).coordy ponEnExcel filalin2, 11, conductoresMultiples(i).intensidad1 ponEnExcel filalin2, 12, conductoresMultiples(i).desfase1 ' Si es horizontal la separacion se le suma a la x, si no a la y If Module1.conductoresMultiples(i).tipo = "2condhoriz" Then filalin2 = filalin2 + 1 ponEnExcel filalin2, 9, conductoresMultiples(i).coordx + _ conductoresMultiples(i).separacion ponEnExcel filalin2, 10, conductoresMultiples(i).coordy ponEnExcel filalin2, 11, conductoresMultiples(i).intensidad1 ponEnExcel filalin2, 12, conductoresMultiples(i).desfase1 Else filalin2 = filalin2 + 1 ponEnExcel filalin2, 9, conductoresMultiples(i).coordx ponEnExcel filalin2, 10, conductoresMultiples(i).coordy + _ conductoresMultiples(i).separacion ponEnExcel filalin2, 11, conductoresMultiples(i).intensidad1 ponEnExcel filalin2, 12, conductoresMultiples(i).desfase1 End If End If i = i + 1 Wend End If ' Fases tríplex If Module1.total3cond > 0 Then i = 1 While (i <= UBound(Module1.tresConductores)) If Module1.tresConductores(i).linea = 1 Then filalin1 = filalin1 + 1 ApExcel.cells(filalin1, 2) = "Triplex Phase" ponEnExcel filalin1, 3, tresConductores(i).coordx ponEnExcel filalin1, 4, tresConductores(i).coordy ponEnExcel filalin1, 5, tresConductores(i).intensidad ponEnExcel filalin1, 6, tresConductores(i).desfase ' Si es tipo I If Module1.tresConductores(i).unoarriba = True Then filalin1 = filalin1 + 1 ponEnExcel filalin1, 3, tresConductores(i).coordx + _ tresConductores(i).d ponEnExcel filalin1, 4, tresConductores(i).coordy ponEnExcel filalin1, 5, tresConductores(i).intensidad ponEnExcel filalin1, 6, tresConductores(i).desfase filalin1 = filalin1 + 1 ponEnExcel filalin1, 3, tresConductores(i).coordx + _ tresConductores(i).d / 2 ponEnExcel filalin1, 4, tresConductores(i).coordy + _ tresConductores(i).h ponEnExcel filalin1, 5, tresConductores(i).intensidad ponEnExcel filalin1, 6, tresConductores(i).desfase Else filalin1 = filalin1 + 1 ponEnExcel filalin1, 3, tresConductores(i).coordx + _ tresConductores(i).d ponEnExcel filalin1, 4, tresConductores(i).coordy ponEnExcel filalin1, 5, tresConductores(i).intensidad ponEnExcel filalin1, 6, tresConductores(i).desfase filalin1 = filalin1 + 1 ponEnExcel filalin1, 3, tresConductores(i).coordx + _ tresConductores(i).d / 2 ponEnExcel filalin1, 4, tresConductores(i).coordy + _ tresConductores(i).h ponEnExcel filalin1, 5, tresConductores(i).intensidad ponEnExcel filalin1, 6, tresConductores(i).desfase End If Else filalin2 = filalin2 + 1 ApExcel.cells(filalin1, 8) = "Triplex Phase" ponEnExcel filalin2, 9, tresConductores(i).coordx ponEnExcel filalin2, 10, tresConductores(i).coordy ponEnExcel filalin2, 11, tresConductores(i).intensidad ponEnExcel filalin2, 12, tresConductores(i).desfase ' Si es tipo I If Module1.tresConductores(i).unoarriba = True Then filalin2 = filalin2 + 1 ponEnExcel filalin2, 9, tresConductores(i).coordx + _ tresConductores(i).d ponEnExcel filalin2, 10, tresConductores(i).coordy ponEnExcel filalin2, 11, tresConductores(i).intensidad ponEnExcel filalin2, 12, tresConductores(i).desfase filalin2 = filalin2 + 1 ponEnExcel filalin2, 9, tresConductores(i).coordx + _ tresConductores(i).d / 2 ponEnExcel filalin2, 10, tresConductores(i).coordy + _ tresConductores(i).h ponEnExcel filalin2, 11, tresConductores(i).intensidad ponEnExcel filalin2, 12, tresConductores(i).desfase Else filalin2 = filalin2 + 1 ponEnExcel filalin2, 9, tresConductores(i).coordx + _ tresConductores(i).d ponEnExcel filalin2, 10, tresConductores(i).coordy ponEnExcel filalin2, 11, tresConductores(i).intensidad ponEnExcel filalin2, 12, tresConductores(i).desfase filalin2 = filalin2 + 1 ponEnExcel filalin2, 9, tresConductores(i).coordx + _ tresConductores(i).d / 2 ponEnExcel filalin2, 10, tresConductores(i).coordy + _ tresConductores(i).h ponEnExcel filalin2, 11, tresConductores(i).intensidad ponEnExcel filalin2, 12, tresConductores(i).desfase End If End If i = i + 1 Wend End If ' Fases cuádruplex If Module1.total4cond > 0 Then i = 1 While (i <= UBound(Module1.cuatroConductores)) If Module1.cuatroConductores(i).linea = 1 Then filalin1 = filalin1 + 1 ApExcel.cells(filalin1, 2) = "Cuadruplex Phase" ponEnExcel filalin1, 3, cuatroConductores(i).coordx ponEnExcel filalin1, 4, cuatroConductores(i).coordy ponEnExcel filalin1, 5, cuatroConductores(i).intensidad1 ponEnExcel filalin1, 6, cuatroConductores(i).desfase1 filalin1 = filalin1 + 1 ponEnExcel filalin1, 3, cuatroConductores(i).coordx + _ cuatroConductores(i).disth ponEnExcel filalin1, 4, cuatroConductores(i).coordy ponEnExcel filalin1, 5, cuatroConductores(i).intensidad1 ponEnExcel filalin1, 6, cuatroConductores(i).desfase1 filalin1 = filalin1 + 1 ponEnExcel filalin1, 3, cuatroConductores(i).coordx + _ cuatroConductores(i).disth ponEnExcel filalin1, 4, cuatroConductores(i).coordy + _ cuatroConductores(i).distv ponEnExcel filalin1, 5, cuatroConductores(i).intensidad1 ponEnExcel filalin1, 6, cuatroConductores(i).desfase1 filalin1 = filalin1 + 1 ponEnExcel filalin1, 3, cuatroConductores(i).coordx ponEnExcel filalin1, 4, cuatroConductores(i).coordy + _ cuatroConductores(i).disth ponEnExcel filalin1, 5, cuatroConductores(i).intensidad1 ponEnExcel filalin1, 6, cuatroConductores(i).desfase1 Else filalin2 = filalin2 + 1 ApExcel.cells(filalin1, 8) = "Cuadruplex Phase" ponEnExcel filalin2, 9, cuatroConductores(i).coordx ponEnExcel filalin2, 10, cuatroConductores(i).coordy ponEnExcel filalin2, 11, cuatroConductores(i).intensidad1 ponEnExcel filalin2, 12, cuatroConductores(i).desfase1 filalin2 = filalin2 + 1 ponEnExcel filalin2, 9, cuatroConductores(i).coordx + _ cuatroConductores(i).disth ponEnExcel filalin2, 10, cuatroConductores(i).coordy ponEnExcel filalin2, 11, cuatroConductores(i).intensidad1 ponEnExcel filalin2, 12, cuatroConductores(i).desfase1 filalin2 = filalin2 + 1 ponEnExcel filalin2, 9, cuatroConductores(i).coordx ponEnExcel filalin2, 10, cuatroConductores(i).coordy + _ cuatroConductores(i).distv ponEnExcel filalin2, 11, cuatroConductores(i).intensidad1 ponEnExcel filalin2, 12, cuatroConductores(i).desfase1 filalin2 = filalin2 + 1 ponEnExcel filalin2, 9, cuatroConductores(i).coordx + _ cuatroConductores(i).disth ponEnExcel filalin2, 10, cuatroConductores(i).coordy + _ cuatroConductores(i).distv ponEnExcel filalin2, 11, cuatroConductores(i).intensidad1 ponEnExcel filalin2, 12, cuatroConductores(i).desfase1 End If i = i + 1 Wend End If End Sub Sub ponEnExcel(ByVal fila As Integer, ByVal col As Integer, ByVal valor As Single) ApExcel.cells(fila, col).NumberFormat = "0.00" ApExcel.cells(fila, col).formula = valor End Sub e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.


PROGRAMA DE DISEÑO DE LAZOS ACTIVOS/PASIVOS PARA AMORTIGUAMIENTO DEL CAMPO MAGNÉTICO EN LÃNEAS ELÉCTRICAS AÉREAS DE ALTA TENSIÓN

: Casas Pérez, José Eduardo De Las
: Ingeniería Industrial
Contenido del proyecto:
Directorio raíz  >  Programa  >  Codigo  >  CrearInforme.bas