UniversoExcelForo

Respuesta a consultas.
Fecha de creación: 09.Abril.2012

Fundadores: Wibly,Tyno,Servando,Sakkar,Rosendo2,RMaximo,Railar,Mcoronel,Ioyama,Igtelo,Hugotron,Drochar,Dedos,Alberto,Adolfo

No se pueden hacer consultas de Excel o VBA por mensaje privado.
Utiliza el botón buscar del foro y te ahorras tiempo para obtener "ayuda".

No estás conectado. Conéctate o registrate

Ver el tema anterior Ver el tema siguiente Ir abajo  Mensaje [Página 1 de 1.]

Manuel TR


Buenas tardes, tengo un archivo Excel que me genera mediante una macro un archivo txt , tomando toda la data de la columna P4 y hace un recorrido de 100 filas hacia abajo pero al generar el txt  salen espacios en blanco, debido a que no siempre las 100 filas van a contener datos, es por eso que requiero que se eliminen los espacios en blanco o en exceso.
Adjunto archivo para su ayuda  y que es lo que me falta para generar un archivo sin espacios en blanco.


Esta es la macro:




Option Private Module

Public Ruta As String

#If VBA7 And Win64 Then




Private Type BROWSEINFO ' used by the function GetFolderName

    hOwner As LongPtr

    pidlRoot As LongPtr

    pszDisplayName As String

    lpszTitle As String

    ulFlags As LongPtr

    lpfn As LongPtr

    lParam As LongPtr

    iImage As LongPtr

End Type







    'Si es de 64 bits

Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" _

    Alias "SHGetPathFromIDListA" (ByVal pidl As LongPtr, ByVal pszPath As String) As LongPtr

Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" _

    Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As LongPtr

    

    #Else

    'Si es de 32 bits

    

    

Private Type BROWSEINFO ' used by the function GetFolderName

    hOwner As Long

    pidlRoot As Long

    pszDisplayName As String

    lpszTitle As String

    ulFlags As Long

    lpfn As Long

    lParam As Long

    iImage As Long

End Type







    Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _

    Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _

    Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

    #End If

    




Function GetFolderName(Msg As String) As String

' returns the name of the folder selected by the user

#If VBA7 And Win64 Then

    'Si es de 64 bits

Dim bInfo As BROWSEINFO, path As String, r As LongPtr

Dim X As LongPtr, pos As Integer

    #Else

    'Si es de 32 bits

    Dim bInfo As BROWSEINFO, path As String, r As Long

Dim X As Long, pos As Integer

    #End If

    

    

    bInfo.pidlRoot = 0& ' Root folder = Desktop

    If IsMissing(Msg) Then

        bInfo.lpszTitle = "Seleccione una Carpeta"

        ' the dialog title

    Else

        bInfo.lpszTitle = "¿En que carpeta desea guardar el Archivo a generar?" ' the dialog title

    End If

    bInfo.ulFlags = &H1 ' Type of directory to return

    

    X = SHBrowseForFolder(bInfo) ' display the dialog

    ' Parse the result

    path = Space$(512)

    r = SHGetPathFromIDList(ByVal X, ByVal path)

    If r Then

        pos = InStr(path, Chr$(0))

        GetFolderName = Left(path, pos - 1) & "\"

        

        If Right(GetFolderName, 2) = "\\" Then GetFolderName = Left(GetFolderName, Len(GetFolderName) - 1)

    Else

        GetFolderName = ""

    End If

End Function







Sub TestGetFolderName()

Dim FolderName As String

    FolderName = GetFolderName("Select a folder")

    If FolderName = "" Then

        MsgBox "No has seleccionado una carpeta válida" & Chr(13) & "Por defecto se seleccionará el disco C:/", vbCritical, "SELECCIONE UNA CARPETA"

    Ruta = "C:\"

    Else

      Ruta = FolderName

    End If

End Sub










Sub procesar()

Call TestGetFolderName

Call Guardar_txt

End Sub










Sub Guardar_txt()

  

    On Error Resume Next

      

      Z = 100

      

  Dim r As Range, c As Range

Dim sTemp As String




archivo = Range("M2").Value & ".txt"




Open Ruta & archivo For Output As #1

For Each r In Hoja2.Range("P4:P" & Z).Rows

sTemp = ""

For Each c In r.Cells

sTemp = sTemp & c.Text & Chr(9)

Next c

'Get rid of trailing tabs

While Right(sTemp, 1) = Chr(9)

sTemp = Left(sTemp, Len(sTemp) - 1)

Wend

Print #1, sTemp

Next r

Close #1







MsgBox "El archivo de nombre: " & archivo & " fue creado con éxito." & Chr(13)







End Sub



Última edición por Manuel TR el 14/08/16, 04:37 pm, editado 1 vez (Razón : error de escritura)

jhon1904


Hola Manuel Tr

Cambias Z = 100 por Z = hoja2.Range("P"&rows.Count).End(xlUp).Row     

espero te sirva

saludos

Manuel TR


Hola jhon1904
antes que nada, darte las gracias por tu tiempo y por la ayuda brindada, fue de gran ayuda tu aporte.

Muchas Gracias


Saludos.. Wink

Ver el tema anterior Ver el tema siguiente Volver arriba  Mensaje [Página 1 de 1.]

Permisos de este foro:
No puedes responder a temas en este foro.