Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Visual Basic » SubIndice Fuera del intervalo

Visual Basic - SubIndice Fuera del intervalo

Life is soft - evento anual de software empresarial
Volver
Nuevo Tema
<<>>
 
Vista:

SubIndice Fuera del intervalo

Publicado por Jorge Castillo (2 intervenciones) el 09/09/2019 14:42:27
Bueno espero que me puedan ayudar. Resulta que en equipo de un usuario al momento de generar un Archivo Excel me arroja el dichoso error el subindice esta fuera del intervalo, ahora bien esto ocurre solo en su P.C a los demás usuarios si les funciona y le ocurre desde que actualizo su S.O a Windows 10 antes no ocurría este es el codigo de la función que genera el Excel

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
Public Function ExportarInformeFacAgroSuperExcel(fechaIni As String, FechaFin As String, FileName As String) As Boolean
 
Dim miIdAplicacion As Long
    Dim miServidor As String
    Dim miDataBase As String
    Dim miLogin As String
    Dim miPassword As String
    Dim miPathImagen As Integer
    Dim miRutaWeb As String
    Dim miCarpetaWeb As String
    Dim miAnexoWeb As String
    Dim miRutaImagenesProduccion As String
    miIdAplicacion = 509
    Dim oRS As ADODB.Recordset
    Dim xSQL As String
    Dim Excel       As Object
    Dim Libro       As Object
    Dim Hoja1       As Object
    Dim Hoja2       As Object
    Dim arrData     As Variant
    Dim iRec        As Long
    Dim iCol        As Integer
    Dim iRow        As Integer
    Dim Registros() As Variant
    Dim NroFilas    As Integer
    Dim descripcion As String
    Dim iRow2       As Integer
    Dim iCol2       As Integer
 
 
    On Error GoTo salir
 
    If bddRescatarParametrosProduccion(miIdAplicacion, fServidor, fLogin, fPassword, fPathImagenes, fRutaProduccion) = False Then
      Exit Function
   End If
 
 
   goConexion.AbrirDAT fServidor, fLogin, fPassword
 
 
   ExportarInformeFacAgroSuperExcel = False
 
 
 
     xSQL = "spFacturacionApp509SelectInforme "
   xSQL = xSQL & Qquote(fechaIni)
   xSQL = xSQL & " , " & Qquote(FechaFin)
 
 
   Set oRS = goConexion.EjecutarRecordset(xSQL)
 
   'If oRS.EOF = False Then

    '  bddCargaArchivoExcel_Agrosuper = True

  ' End If

 
      ' -- Crear los objetos para utilizar el Excel

    Set Excel = CreateObject("Excel.Application")
    Set Libro = Excel.Workbooks.Add
 
    ' -- Hacer referencia a la hoja

    Set Hoja1 = Libro.Worksheets(1)
    Hoja1.Name = "Grupo AgroSuper"
 
    Set Hoja2 = Libro.Worksheets(2)
    Hoja2.Name = "Grupo Viñedos y Frutales"
 
 
    Excel.Visible = False: Excel.UserControl = True
 
 
    iCol = oRS.Fields.Count
    iCol2 = 1
      For iCol = 4 To oRS.Fields.Count
        Hoja1.Cells(1, iCol2).Value = oRS.Fields(iCol - 1).Name
        iCol2 = iCol2 + 1
    Next
 
    If Val(Mid(Excel.Version, 1, InStr(1, Excel.Version, ".") - 1)) > 8 Then
 
        ' obtiene el conjunto de filas

       Registros = oRS.GetRows()
 
        NroFilas = UBound(Registros, 2) + 1
 
      oRS.MoveFirst
 
 
       iRow2 = 1
 
        For iRow = 0 To NroFilas - 1
          If oRS(2).Value <> "2" Then
            iCol2 = 1
            For iCol = 4 To oRS.Fields.Count
 
                If iCol = 5 Then
                  Hoja1.Columns(iCol2).NumberFormat = "@"
                End If
 
                Hoja1.Cells(iRow2 + 1, iCol2).Value = oRS.Fields(iCol - 1).Value
                iCol2 = iCol2 + 1
            Next
            iRow2 = iRow2 + 1
           End If
 
        oRS.MoveNext
 
 
        Next iRow
 
 
        'Hoja 2

 
         iCol = oRS.Fields.Count
         iCol2 = 1
 
      For iCol = 4 To oRS.Fields.Count
         Hoja2.Cells(1, iCol2).Value = oRS.Fields(iCol - 1).Name
         iCol2 = iCol2 + 1
      Next
 
 
        oRS.MoveFirst
 
 
       iRow2 = 1
 
        For iRow = 0 To NroFilas - 1
          If oRS(2).Value = "2" Then
            iCol2 = 1
            For iCol = 4 To oRS.Fields.Count
                'objWorksheet.Columns(columna).NumberFormat = "@"

 
                If iCol = 5 Then
                  Hoja2.Columns(iCol2).NumberFormat = "@"
                  Hoja2.Columns(iCol2).EntireColumn.AutoFit
 
 
                End If
 
                Hoja2.Cells(iRow2 + 1, iCol2).Value = oRS.Fields(iCol - 1).Value
                iCol2 = iCol2 + 1
            Next
            iRow2 = iRow2 + 1
           End If
 
        oRS.MoveNext
 
        Next iRow
 
 
      '  Hoja1.Cells(2, 1).CopyFromRecordset oRS 'Esta linea hay que reemplazarla

 
 
    Else
 
        arrData = oRS.GetRows
 
        iRec = UBound(arrData, 2) + 1
 
        For iCol = 0 To oRS.Fields.Count - 1
            For iRow = 0 To iRec - 1
 
                If IsDate(arrData(iCol, iRow)) Then
                    arrData(iCol, iRow) = Format(arrData(iCol, iRow))
 
                ElseIf IsArray(arrData(iCol, iRow)) Then
                    arrData(iCol, iRow) = "Array Field"
                End If
            Next iRow
        Next iCol
 
        ' -- Traspasa los datos a la hoja de Excel

        Hoja1.Cells(2, 1).Resize(iRec, oRS.Fields.Count).Value = GetDataExcel(arrData)
    End If
 
    Excel.Selection.CurrentRegion.Columns.AutoFit
    Excel.Selection.CurrentRegion.Rows.AutoFit
 
     ' -- guardar el libro

    Libro.SaveAs FileName
    Libro.Close
    ' -- Elimina las referencias Xls

    Set Hoja1 = Nothing
    Set Hoja2 = Nothing
    Set Libro = Nothing
    Excel.Quit
    Set Excel = Nothing
 
    ExportarInformeFacAgroSuperExcel = True
 
    Exit Function
 
 
   oRS.Close
 
salir:
  descripcion = Err.Description
  ErrorInformeExcel = Err.Description
 
 
   Set oRS = Nothing
   goConexion.Cerrar
 
 
End Function
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 1.259
Plata
Ha mantenido su posición en Visual Basic (en relación al último mes)
Gráfica de Visual Basic

SubIndice Fuera del intervalo

Publicado por Antoni Masana (565 intervenciones) el 09/09/2019 21:03:54
En primer lugar el código es un poco caótico.
En segundo lugar supongo que tenemos que adivinar donde se produce el error.

Pues adivina adivinanza el error es muy probable que se produzca en la línea que hace referencia a la hoja2 (Linea 64 de tu código).

Y siguiendo con las adivinanzas cuando creas un libro estas seguro de que tendrá 2 hoja porque lo has probado en tu equipo y funciona y Excel no tiene una opción para decirle con cuantas hojas tiene que crear un libro.

Opciones ==> General ==> Al crear nuevos libros ==> Incluir este número de hojas ==> [ 1 ]

Asi se lee algo mejor:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
Public Function ExportarInformeFacAgroSuperExcel(fechaIni As String, FechaFin As String, FileName As String) As Boolean
 
Dim miIdAplicacion As Long
    Dim miServidor As String
    Dim miDataBase As String
    Dim miLogin As String
    Dim miPassword As String
    Dim miPathImagen As Integer
    Dim miRutaWeb As String
    Dim miCarpetaWeb As String
    Dim miAnexoWeb As String
    Dim miRutaImagenesProduccion As String
    miIdAplicacion = 509
    Dim oRS As ADODB.Recordset
    Dim xSQL As String
    Dim Excel       As Object
    Dim Libro       As Object
    Dim Hoja1       As Object
    Dim Hoja2       As Object
    Dim arrData     As Variant
    Dim iRec        As Long
    Dim iCol        As Integer
    Dim iRow        As Integer
    Dim Registros() As Variant
    Dim NroFilas    As Integer
    Dim descripcion As String
    Dim iRow2       As Integer
    Dim iCol2       As Integer
 
    On Error GoTo salir
 
    If bddRescatarParametrosProduccion(miIdAplicacion, fServidor, fLogin, fPassword, fPathImagenes, fRutaProduccion) = False Then
        Exit Function
    End If
 
    goConexion.AbrirDAT fServidor, fLogin, fPassword
    ExportarInformeFacAgroSuperExcel = False
 
    xSQL = "spFacturacionApp509SelectInforme "
    xSQL = xSQL & Qquote(fechaIni)
    xSQL = xSQL & " , " & Qquote(FechaFin)
 
    Set oRS = goConexion.EjecutarRecordset(xSQL)
 
    'If oRS.EOF = False Then

    '    bddCargaArchivoExcel_Agrosuper = True

    'End If

 
    ' -- Crear los objetos para utilizar el Excel

    Set Excel = CreateObject("Excel.Application")
    Set Libro = Excel.Workbooks.Add
 
    ' -- Hacer referencia a la hoja

    Set Hoja1 = Libro.Worksheets(1)
    Hoja1.Name = "Grupo AgroSuper"
 
    Set Hoja2 = Libro.Worksheets(2)
    Hoja2.Name = "Grupo Viñedos y Frutales"
 
    Excel.Visible = False: Excel.UserControl = True
 
    iCol = oRS.Fields.Count
    iCol2 = 1
    For iCol = 4 To oRS.Fields.Count
        Hoja1.Cells(1, iCol2).Value = oRS.Fields(iCol - 1).Name
        iCol2 = iCol2 + 1
    Next
 
    If Val(Mid(Excel.Version, 1, InStr(1, Excel.Version, ".") - 1)) > 8 Then
        ' obtiene el conjunto de filas

        Registros = oRS.GetRows()
        NroFilas = UBound(Registros, 2) + 1
        oRS.MoveFirst
        iRow2 = 1
        For iRow = 0 To NroFilas - 1
            If oRS(2).Value <> "2" Then
                iCol2 = 1
                For iCol = 4 To oRS.Fields.Count
                    If iCol = 5 Then
                        Hoja1.Columns(iCol2).NumberFormat = "@"
                    End If
                    Hoja1.Cells(iRow2 + 1, iCol2).Value = oRS.Fields(iCol - 1).Value
                    iCol2 = iCol2 + 1
                Next
                iRow2 = iRow2 + 1
            End If
            oRS.MoveNext
        Next iRow
       'Hoja 2

        iCol = oRS.Fields.Count
        iCol2 = 1
 
        For iCol = 4 To oRS.Fields.Count
            Hoja2.Cells(1, iCol2).Value = oRS.Fields(iCol - 1).Name
            iCol2 = iCol2 + 1
        Next
        oRS.MoveFirst
        iRow2 = 1
 
        For iRow = 0 To NroFilas - 1
            If oRS(2).Value = "2" Then
                iCol2 = 1
                For iCol = 4 To oRS.Fields.Count
                   'objWorksheet.Columns(columna).NumberFormat = "@"

                    If iCol = 5 Then
                         Hoja2.Columns(iCol2).NumberFormat = "@"
                         Hoja2.Columns(iCol2).EntireColumn.AutoFit
                     End If
                     Hoja2.Cells(iRow2 + 1, iCol2).Value = oRS.Fields(iCol - 1).Value
                    iCol2 = iCol2 + 1
                Next
                iRow2 = iRow2 + 1
            End If
            oRS.MoveNext
        Next iRow
     '  Hoja1.Cells(2, 1).CopyFromRecordset oRS 'Esta linea hay que reemplazarla

    Else
        arrData = oRS.GetRows
        iRec = UBound(arrData, 2) + 1
        For iCol = 0 To oRS.Fields.Count - 1
            For iRow = 0 To iRec - 1
                If IsDate(arrData(iCol, iRow)) Then
                    arrData(iCol, iRow) = Format(arrData(iCol, iRow))
                ElseIf IsArray(arrData(iCol, iRow)) Then
                    arrData(iCol, iRow) = "Array Field"
                End If
            Next iRow
        Next iCol
        ' -- Traspasa los datos a la hoja de Excel

        Hoja1.Cells(2, 1).Resize(iRec, oRS.Fields.Count).Value = GetDataExcel(arrData)
    End If
 
    Excel.Selection.CurrentRegion.Columns.AutoFit
    Excel.Selection.CurrentRegion.Rows.AutoFit
 
     ' -- guardar el libro

    Libro.SaveAs FileName
    Libro.Close
    ' -- Elimina las referencias Xls

    Set Hoja1 = Nothing
    Set Hoja2 = Nothing
    Set Libro = Nothing
    Excel.Quit
    Set Excel = Nothing
    ExportarInformeFacAgroSuperExcel = True
 
    oRS.Close
    Exit Function
    oRS.Close
 
salir:
    descripcion = Err.Description
    ErrorInformeExcel = Err.Description
    Set oRS = Nothing
    goConexion.Cerrar
End Function

Y otra cosa antes de salir de la función cierra el fichero no después de salir.

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar