Amigos,probe el codigo y sigue con errores, el problema es que el nombre de la hoja si es hoja 1.
Envio detalle del problema.
Area_Archivo = FreeFile
dn_filas_planillas = 1
dc_cuenta_anterior_proceso = ""
dc_otra_moneda_anterior = 0
ExcelApp.Cells.NumberFormat = "@" ' Formato Texto
Open dg_archivo_origen For Input As Area_Archivo
Do While Not EOF(Area_Archivo)
Line Input #Area_Archivo, dl_linea_archivo
dn_filas_planillas = dn_filas_planillas + 1
hoja.Cells(dn_filas_planillas, C_Columna_dc_sucursal) = dc_sucursal_CDC
dl_valores_fila_excel(C_Columna_dc_sucursal) = dc_sucursal_CDC
hoja.Cells(dn_filas_planillas, C_Columna_dc_periodo) = dc_periodo_CDC
dl_valores_fila_excel(C_Columna_dc_periodo) = dc_periodo_CDC
hoja.Cells(dn_filas_planillas, C_Columna_dc_tipo_auxiliar) = ""
dl_valores_fila_excel(C_Columna_dc_tipo_auxiliar) = ""
----
Aca viene el llenado de datos...es demasiado extenso como para ponerlo aca....pero no tiene problemas...
Loop
Close #Area_Archivo
' ExcelApp.rows("1:1").Select
' ExcelApp.Selection.AutoFilter
libro.SaveAs FileName:=dg_ruta_archivo_destino, ConflictResolution:=xlLocalSessionChanges
libro.Close savechanges:=False
Set hoja = Nothing
Set libro = Nothing
Set ExcelApp = Nothing
' Por problemas de rutina de ordenamiento en excel, se procede a realizar orden en recordset
'------------------------------------------------------------------------------------------
' ExcelApp.Cells.Select
' ExcelApp.Selection.Sort Key1:=Range("P2"), Order1:=xlAscending, Header:=xlGuess, _
' OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
' ExcelApp.Cells.Clear
'------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------<>
MsgBox "Se intenta realizar la carga del excel recien creado", vbExclamation
Call CargarPlanillaExcel(dg_ruta_archivo_destino)
MsgBox "Este mensaje significa que ya se realizo la carga del excel", vbExclamation
MsgBox "Comienza el llenado", vbExclamation
'Llenar RS desde Grilla
Set rs = UtilADO.CreaRecordsetDesdeGrilla(Me.GrdMovimiento)
If rs Is Nothing Then
MsgBox "Error al cargar Grilla a Recordset", vbExclamation
Screen.MousePointer = vbDefault
Exit Sub
End If
If rs.RecordCount = 0 Then
MsgBox "Error al cargar Grilla a Recordset", vbExclamation
Screen.MousePointer = vbDefault
Exit Sub
End If
If FieldExists(rs, "orden") Then
rs.Sort = "orden"
End If
'Este es el procedimiento
Private Sub CargarPlanillaExcel(dg_nombre_archivo As String)
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim k As Long
Dim dn_ind As Integer
Dim dg_resultado As String
Screen.MousePointer = vbHourglass
Me.GrdMovimiento.MaxRows = 0
Me.GrdMovimiento.MaxCols = 0
MsgBox "Confirmacion del nombre de archivo", vbExclamation
If dg_nombre_archivo = "" Then
Screen.MousePointer = vbDefault
Exit Sub
End If
MsgBox "Confirmacion del directorio de archivo", vbExclamation
If Dir(dg_nombre_archivo) = "" Then
Screen.MousePointer = vbDefault
Exit Sub
End If
MsgBox "Se intenta establecer la nueva conexion", vbExclamation
' Establecemos una conexión con el libro de trabajo
Set cnn = New ADODB.Connection
'With cnn
' .Provider = "Microsoft.Jet.OLEDB.4.0"
' .ConnectionString = "Data Source = " + dg_nombre_archivo
' .Properties("Extended Properties") = "Excel 8.0;HDR=Yes"
' .Open
'End With
' Open the Connection
MsgBox "Ruta y nombre del archivo:" + dg_nombre_archivo, vbExclamation
cnn.Open _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" + dg_nombre_archivo + ";Extended Properties=""Excel 8.0;HDR=No"""
MsgBox "Si puede leer esto entonces no es problema de conexion", vbExclamation
MsgBox "Se inicializa el recordset", vbExclamation
' Creamos un nuevo objeto Recordset
Set rs = New ADODB.Recordset
With rs
Set .ActiveConnection = cnn
' Indicamos el nombre de la hoja
.Source = "[Hoja1$]"
.Open
End With
MsgBox "Ya se establece una hoja excel determinada para el proceso", vbExclamation
If rs Is Nothing Then
Screen.MousePointer = vbDefault
Exit Sub
End If
With Me.GrdMovimiento
.MaxCols = rs.Fields.Count
rs.MoveFirst
MsgBox "Se llenan las columnas del nuevo libro", vbExclamation
'Titulos Columnas
For k = 1 To .MaxCols
.Row = 0
.Col = k
.Text = rs.Fields(k - 1).Name
Next k
rs.MoveFirst
Do Until rs.EOF
.MaxRows = .MaxRows + 1
.Row = .MaxRows
For k = 1 To .MaxCols
.Col = k
.Text = IIf(IsNull(rs.Fields(k - 1).value), 0, rs.Fields(k - 1).value)
Next k
rs.MoveNext
Loop
End With
cnn.Close
Screen.MousePointer = vbDefault
MsgBox "Fin Sub area Problematica", vbExclamation
On Error GoTo 0
Exit Sub
End Sub
Bueno eso es, espero me ayuden porque llevo bastante tiempo y nada...
Gracias.
