Tem alguns detalhes no código que precisa rever na questão de salvar em xlsm, mas o restante está funcionado bem.
Coloquei também dentro da pasta um arquivo xls de compatibilidade.
Segue em anexo o projeto, espere que gostem.
![Rindo :lol:](./images/smilies/icon_lol.gif)
Moderador: Rafael Monteiro
Código: Selecionar todos
Sub Exportar()
Application.DisplayAlerts = False
template_file = ActiveWorkbook.FullName
fileSaveName = Application.GetSaveAsFilename( _
InitialFileName:="C:\users" + _
VBA.Strings.Format(Now, "mmddyyyy") + ".txt", _
fileFilter:="Text Files (*.txt), *.txt")
If fileSaveName = False Then
Exit Sub
End If
'cria uma cópia da pasta de trabalho atual da planilha atual
Dim newBook As Workbook
Dim plan As Worksheet
Set newBook = Workbooks.Add
ThisWorkbook.ActiveSheet.Copy Before:=newBook.Sheets(1)
'exclui as demais planilhas
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
'fecha a pasta de trabalho gerada
newBook.Close SaveChanges:=True
Set newBook = Nothing
MsgBox "O arquivo foi exportado com sucesso! ", vbInformation, "Exportar arquivos"
Orcamento.Show
End Sub
Código: Selecionar todos
Sub Estrutura_Xml()
Dim sEnv As String
sEnv = "<?xml version=""1.0"" encoding=""UTF-8"" ?>" & Chr(13) & Chr(10)
sEnv = sEnv & "<downloadNFe xmlns=""http://www.portalfiscal.inf.br/nfe"" versao=""1.00"">" & Chr(13) & Chr(10)
sEnv = sEnv & " <tpAmb>" & Ambiente & "</tpAmb>" & Chr(13) & Chr(10)
sEnv = sEnv & " <xServ>DOWNLOAD NFE</xServ>" & Chr(13) & Chr(10)
sEnv = sEnv & " <CNPJ>" & CNPJ & "</CNPJ>" & Chr(13) & Chr(10)
sEnv = sEnv & " <chNFe>" & "00000000000000000000000000000000000000000000" & "</chNFe>" & Chr(13) & Chr(10)
sEnv = sEnv & "</downloadNFe>"
MsgBox sEnv
End Sub
Código: Selecionar todos
Sub Exportar()
Application.DisplayAlerts = False
template_file = ActiveWorkbook.FullName
fileSaveName = Application.GetSaveAsFilename( _
InitialFileName:="C:\Users\XML Entrada\" + _
VBA.Strings.Format(Now, "mmddyyyyhhmmss") + ".xml", _
fileFilter:="Text Files (*.xml), *.xml")
If fileSaveName = False Then
Exit Sub
End If
'cria uma cópia da pasta de trabalho atual da planilha atual
Dim newBook As Workbook
Dim plan As Worksheet
Set newBook = Workbooks.Add
ThisWorkbook.ActiveSheet.Copy Before:=newBook.Sheets(1)
'exclui as demais planilhas
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
'fecha a pasta de trabalho gerada
newBook.Close SaveChanges:=True
Set newBook = Nothing
MsgBox "O arquivo foi exportado com sucesso! ", vbInformation, "Exportar arquivos"
End Sub
Boa Tarde webmaster, venho te comunicar que o link postado no blog que menciona esse tópico está corrompido, como fui indicado ao post do blog pelo google acabei tendo que adaptar o link para abrir o tópico neste fórum!webmaster escreveu: ↑Sex Mar 09, 2012 4:34 pm Rafael,
Ficou bom, mas encontrei um problema, se é que dá para chamar de problema. Depois da exportação, a planilha ativa se "transforma" no txt exportado, já que você utiliza o SaveAs. Com isso, não é possível continuar trabalhando no arquivo. Reescrevi a macro Exportar para ficar da seguinte forma:Assim, o arquivo exportado fica independente. O que acha?Código: Selecionar todos
Sub Exportar() Application.DisplayAlerts = False template_file = ActiveWorkbook.FullName fileSaveName = Application.GetSaveAsFilename( _ InitialFileName:="C:\users" + _ VBA.Strings.Format(Now, "mmddyyyy") + ".txt", _ fileFilter:="Text Files (*.txt), *.txt") If fileSaveName = False Then Exit Sub End If 'cria uma cópia da pasta de trabalho atual da planilha atual Dim newBook As Workbook Dim plan As Worksheet Set newBook = Workbooks.Add ThisWorkbook.ActiveSheet.Copy Before:=newBook.Sheets(1) 'exclui as demais planilhas 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 'fecha a pasta de trabalho gerada newBook.Close SaveChanges:=True Set newBook = Nothing MsgBox "O arquivo foi exportado com sucesso! ", vbInformation, "Exportar arquivos" Orcamento.Show End Sub
Posso publicar o código no blog?
Abraços
Código: Selecionar todos
Dim Nome_Arquivo
Nome_Arquivo = (Activeworkbook.path & "\temp\" & activesheet.name & " " & format(date, "dd-mm-yyyy") & ".txt")