Programación General > Visual Basic 6.0 e inferiores

 Programa Funciona Bien En Mi Pc Pero En Otros No

<< < (2/2)

neorent:
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.   :hola:

Navegación

[0] Índice de Mensajes

[*] Página Anterior