Jump to content
Pennafortt

Informar intervalo em exportar para txt

Recommended Posts

Pennafortt

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

Share this post


Link to post
Share on other sites
FreiNando

"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

Share this post


Link to post
Share on other sites
Pennafortt

boas freiNando

agradeço por ter respondido mas quero informar que as vezes o txt é salvo no desktop (area de trabalho) mais isso não chega ser importante, queria saber mesmo é como salvar não o ficheiro todo, mas só o intervalo J20:X200, uma vez que a macro salva a planilha inteira

cimps

Share this post


Link to post
Share on other sites
FreiNando

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

Share this post


Link to post
Share on other sites
V10

Boa tarde!

Estou com o ,mesmo problema. Quero apenas exportar um range de celulas. Mas a segunda macro sugerida da erro.Como posso adaptar a primeira macro para exportar apenas a coluna A e B?

Obrigado,

Cumps

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • 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.