Ver Mensaje Individual
  #3 (permalink)  
Antiguo 02/07/2015, 09:07
andresito12_19
 
Fecha de Ingreso: noviembre-2008
Mensajes: 80
Antigüedad: 15 años, 5 meses
Puntos: 1
Respuesta: pasar de excel a archivo Plano

buen dia alguien me podria explicar este codigo de VBA

Código PHP:
Public Function GeneradorXml(FullPath As StringFmtoName As StringAnexo As String) As Boolean
Application
.ScreenUpdating False
On Error GoTo ErrorHandler

Dim colIndex 
As Integer
Dim rwIndex 
As Integer
Dim asCols
() As String
Dim oWorkSheet 
As Worksheet
Dim Datosworksheet 
As Worksheet
Dim sName 
As String
Dim lCols 
As LonglRows As Longcampo As Long
Dim iFileNum 
As Integer

Set oWorkSheet 
ThisWorkbook.Worksheets(1)
sName oWorkSheet.Name
lCols 
oWorkSheet.Columns.Count
lRows 
2

ReDim asCols
(lCols) As String

iFileNum 
FreeFile
Open FullPath 
For Output As #iFileNum

Worksheets(FmtoName).Activate
datosname 
Worksheets(FmtoName).Name
datoscols 
Worksheets(FmtoName).Columns.Count
datosrows 
Worksheets(FmtoName).Rows.Count
campo 
0


For 0 To datoscols 1
    
If Trim(Cells(11).Value) = "" Then Exit For
    
Next k
    
If 0 Then GoTo ErrorHandler
    datoscols 
k


For 0 To datosrows 1
    
If Trim(Cells(11).Value) = "" Then Exit For
    
Next m
    
If 0 Then GoTo ErrorHandler
datosrows 
m


For 4 To datosrows
    
If Trim(Cells(i1).Value) = "" Then Exit For
    For 
2 To datoscols
            campo 
Cells(3j).Value
            espaciosalf 
String((campo Len(Trim(Cells(ij).Value))), " ")
            
espacios String((campo Len(Trim(Cells(ij).Value))), "0")
           If (
Cells(2j).Value) = "Num" Then
           
Print #iFileNum, espacios & Trim(Cells(i, j).Value);
           
Else
           Print 
#iFileNum, Trim(Cells(i, j).Value) & espaciosalf;
           
End If
  
    
Next j
Print #iFileNum, vbLine
Next i


ExportToXml 
True
MsgBox 
"Archivo Generado Correctamente en c:\" & FmtoName & ".DAT     ", vbInformation
oWorkSheet.Activate
End

ErrorHandler:
If iFileNum > 0 Then Close #iFileNum
MsgBox "
No se pudo generar el archivo " & FmtoName & ".TXT'  " & vbCrLf & vbCrLf & _
"1-. Verifique y corrija el siguiente campo que excedio el espacio asignado" & vbCrLf & vbCrLf & _
"HOJA         :  " & datosname & vbCrLf & "COLUMNA  :  " & Cells(1, j).Value & vbCrLf & "FILA           :  " _
& i & vbCrLf & vbCrLf & "Campo : '" & Cells(i, j) & "" & vbCrLf & "
Ancho Maximo del Campo " & Cells(3, j).Value _
& vbCrLf & "
Ancho del Registro            " & Len(Trim(Cells(i, j).Value)), vbCritical
oWorkSheet.Activate
Exit Function
End Function