Export tabbed text in Excel

1

Hello

I need to generate a text file based on this layout to be imported into a system. I'm trying to use Excel, I create the cells with the appropriate sizes as the layout asks.

In Excel I go to "save as" and I choose: "Formatted text (separated by space) prn" is almost all right, but in from line 27 it unconfigures, will give a line break. It would require that the final file remain the same as Excel but in txt and obeying the tabulations.

I tried saving with all other Excel options but did not obey the tabs in the final file.

Can anyone help me? Is it possible to do this by Excel? From what I understand is a limitation of .prn

layoyt:

Erroroutput:

    
asked by anonymous 08.06.2017 / 12:12

1 answer

1

In fact there is a limitation in Excel up to 240 for columns, but Microsoft itself gives us a light.

Below is a template adapted from Microsoft to export all data from the active worksheet to a text file:

Sub ExportText()

Dim delimiter As String
Dim quotes As Integer
Dim Returned As String

   delimiter = " "

   quotes = MsgBox("Coloca informações das células com aspas?", vbYesNo)

   ' Chama a função WriteFile
   Returned = WriteFile(delimiter, quotes)

   ' Mensagem Final
   Select Case Returned
      Case "Canceled"
          MsgBox "A operação foi cancelada"
      Case "Exported"
         MsgBox "O arquivo foi exportado com sucesso!"
   End Select

End Sub


Function WriteFile(delimiter As String, quotes As Integer) As String

Dim CurFile As String
Dim SaveFileName
Dim CellText As String
Dim RowNum As Integer
Dim ColNum As Integer
Dim FNum As Integer
Dim TotalRows As Double
Dim TotalCols As Double

' Indica local e arquivo a ser exportado
If Left(Application.OperatingSystem, 3) = "Win" Then
   SaveFileName = Application.GetSaveAsFilename(CurFile, _
   "Text Delimited (*.txt), *.txt", , "Text Delimited Exporter")
Else
    SaveFileName = Application.GetSaveAsFilename(CurFile, _
   "TEXT", , "Text Delimited Exporter")
End If

   ' Verifica se pressionou cancelar
   If SaveFileName = False Then
      WriteFile = "Canceled"
      Exit Function
   End If

  ' Inicia processo de escrita no arquivo
   FNum = FreeFile()

  Open SaveFileName For Output As #FNum

  ' Seleciona na planilha ativa as células utilizada 
  ActiveSheet.usedrange.select

  ' Busca o total de linhas e colunas selecionadas
  TotalRows = Selection.Rows.Count
  TotalCols = Selection.Columns.Count

  ' Inicia Loop para salvar cada célula no arquivo
  For RowNum = 1 To TotalRows
      For ColNum = 1 To TotalCols
         With Selection.Cells(RowNum, ColNum)
         Dim ColWidth as Integer
         ColWidth=Application.RoundUp(.ColumnWidth, 0)
         ' Grava o conteúdo da célula na variável
         Select Case .HorizontalAlignment
            Case xlRight
               CellText = Space(Abs(ColWidth - Len(.Text))) & .Text
            Case xlCenter
               CellText = Space(Abs(ColWidth - Len(.Text))/2) & .Text & _
                          Space(Abs(ColWidth - Len(.Text))/2)
            Case Else
               CellText = .Text & Space(Abs(ColWidth - Len(.Text)))
         End Select
         End With

         ' Grava o arquvio
         Select Case quotes
            Case vbYes
               CellText = Chr(34) & CellText & Chr(34) & delimiter
            Case vbNo
               CellText = CellText & delimiter
         End Select
         Print #FNum, CellText;

         ' Atualiza a barra de status conforme progresso
         Application.StatusBar = Format((((RowNum - 1) * TotalCols) _
            + ColNum) / (TotalRows * TotalCols), "0%") & " Completed."

      ' Próxima coluna no Loop
      Next ColNum

      ' Adiciona quebra de linha no final de cada linha
      If RowNum <> TotalRows Then Print #FNum, ""

   ' Proxima linha no Loop
   Next RowNum

   ' Fecha o arquivo
   Close #FNum

   ' Reseta a barra de status
   Application.StatusBar = False
   WriteFile = "Exported"
End Function

Source: link

    
08.06.2017 / 14:36