Public Sub ExportToTextFile(FName As String, _
Sep As String, SelectionOnly As Boolean)
Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String
Dim r, c As Long
Application.ScreenUpdating = False
On Error GoTo EndMacro:
FNum = FreeFile
If SelectionOnly = True Then
With Selection
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
Else
StartRow = 2
StartCol = 1
EndRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
EndCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
End If
Open FName For Output Access Write As #FNum
For RowNdx = StartRow To EndRow
WholeLine = ""
For ColNdx = StartCol To EndCol
Select Case ColNdx
Case 1
CellValue = Cells(RowNdx, ColNdx).Value
Case 2
CellValue = Cells(RowNdx, ColNdx).Value
Case 3
CellValue = Cells(RowNdx, ColNdx).Value
Case 4
CellValue = Cells(RowNdx, ColNdx).Value
Case 5
CellValue = Cells(RowNdx, ColNdx).Value
Case 6
CellValue = Cells(RowNdx, ColNdx).Value
End Select
WholeLine = WholeLine & CellValue & Sep
Next ColNdx
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #FNum, WholeLine
Next RowNdx
EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #FNum
End Sub
Sub Selecao()
ExportToTextFile FName:="C:\AAA_temp\layout_dominio.txt", Sep:=";", SelectionOnly:=True
End Sub
Sub Tudo()
ExportToTextFile FName:="C:\AAA_temp\layout_dominio.txt", Sep:=";", SelectionOnly:=False
End Sub
Preciso de ajuda para que meus dados da coluna C (valor contábil) do excell seja exportado para txt considerando os 2 dígitos depois da vírgula.
Meu código VBA é:
