Jump to content

Informar intervalo em exportar para txt


Pennafortt

Recommended Posts

boas

utilizo essa macro e funciona não muito bem, preciso que copie e exporte para o txt um intervalo especifico da planilha J20:X200,

A macro:

Sub Exportar_Txt()

Application.DisplayAlerts = False

template_file = ActiveWorkbook.FullName

Aqui era para salvar no desktop mas ta copiando para meus documentos

fileSaveName = "Desktop" + VBA.Strings.Format(Now, "ddmmyyyy") + ".txt"

Dim newBook As Workbook

Dim plan As Worksheet

Set newBook = Workbooks.Add

ThisWorkbook.ActiveSheet.Copy Before:=newBook.Sheets(1)

For Each plan In newBook.Sheets

If plan.Name <> ActiveSheet.Name Then

newBook.Worksheets(plan.Index).Delete

End If

Next

newBook.SaveAs Filename:=fileSaveName, FileFormat:=xlTextWindows, CreateBackup:=False

newBook.Close SaveChanges:=True

Set newBook = Nothing

End Sub

cump

Link to comment
Share on other sites

"Desktop" é uma pasta de sistema. Para obter o enderesso real dessa e de outras pastas de sistema, eu tenho uma função:

'====================================
'		 PASTAS DO SISTEMA
'====================================
Public Function PastaSistema(NumPasta As Integer) As String
Dim objFSO As Object
Dim objShell As Object
Dim objFolder As Object
Dim objFolderItem As Object

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace((NumPasta))  ' Ver Lista
If objFolder Is Nothing Then
	PastaSistema = ""
Else
	Set objFolderItem = objFolder.Self
	PastaSistema = objFolderItem.Path
End If
End Function
'-------------------------------------------
'Lista de Pastas de Sistema
'-------------------------------------------
' Num  --  Nome (PT)
'---------------------------------------
' 2  --  Programas
' 5  --  Os Meus Documentos
' 6  --  Favoritos
' 7  --  Arranque
' 8  --  Itens recentes
' 9  --  SendTo
'11  --  Menu Iniciar
'13  --  A Minha Música
'14  --  Os Meus Vídeos
'16  --  Ambiente de trabalho
'17  --  Computador
'20  --  Fonts
'22  --  Menu Iniciar
'23  --  Programas
'24  --  Arranque
'25  --  Ambiente de Trabalho Público
'26  --  Roaming
'27  --  Printer Shortcuts
'28  --  Local
'29  --  Arranque
'30  --  Arranque
'31  --  Favoritos
'32  --  Temporary Internet Files
'33  --  Cookies
'34  --  History
'35  --  ProgramData
'36  --  Windows
'37  --  System32
'38  --  Program Files (x86)
'39  --  As Minhas Imagens
'40  --  [utilizador]
'41  --  SysWOW64
'42  --  Program Files (x86)
'43  --  Common Files
'45  --  Templates
'46  --  Documentos Públicos
'48  --  Ferramentas Administrativas
'49  --  Ligações de rede
'53  --  Música Pública
'54  --  Imagens Públicas
'55  --  Vídeos Públicos
'-------------------------------------------

Aí a tua linha a vermelho ficaria:

fileSaveName = PastaSistema(16) & VBA.Strings.Format(Now, "ddmmyyyy") & ".txt"

  • Vote 1

O caminho mais curto para conseguir fazer muitas coisas é fazer uma de cada vez. Samuel Smiles

Link to comment
Share on other sites

Para não andares com copy-paste, experimenta esta macro:

Sub ExportarXlRange()
Dim Ficheiro As String, N As Integer
Dim Rg As Range, C As Range, L As Range

'Aqui é para salvar no desktop
Ficheiro = PastaSistema(16) & "\" & Format(Now, "ddmmyyyy") & ".txt"

Set Rg = ActiveSheet.Range("J20:X200")

N = FreeFile
Open Ficheiro For Output As N ' Abre o ficheiro para escrita

For Each L In Rg.Rows
	For Each C In L.Columns
		Print #N, C.Value; vbTab; ' escreve o valor da celula + uma tabulação
	Next
	Print #N, ' nova linha
Next

Close N ' fecha o ficheiro

MsgBox "Exportação concluída"
End Sub

Usei a tabulação como separador de colunas porque o Excel naquela função que usaste faz isso.

Podes substituir o C.Value por C.Text para te aparecer no ficheiro de texto exactamente como na folha, com formatação.

Edited by FreiNando

O caminho mais curto para conseguir fazer muitas coisas é fazer uma de cada vez. Samuel Smiles

Link to comment
Share on other sites

  • 1 year later...

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.