Ir ao conteúdo
  • Cadastre-se

Helder Santos

Membro Júnior
  • Posts

    1
  • Cadastrado em

  • Última visita

Tudo que Helder Santos postou

  1. Boa tarde galera. Preciso de uma macro para exportar dados de uma planilha excel para txt., porém, as colunas que irei importar mudam de planilha para planilha, assim, teria que seleciona-las manualmente. Encontrei essa macro na internet que quase corresponde para o que preciso, porém, quando seleciono colunas intercaladas, ela não funciona. Alguém conseguiria me ajudar com isso? Agradeço muito. Anexei uma planilha como exemplo, onde as colunas em amarelo seriam as que eu precisaria exportar para txt. Segue a macro: Sub ExportaTxt() Dim delimitador As String Dim infos As Integer Dim Retorna As String delimitador = " " infos = MsgBox("Utilizar aspas ao redor das informações?", vbYesNo) 'Chama a função WriteFile passando as opções delimitador e aspas. Retorna = WriteFile(delimitador, infos) ' Mostra a caixa de mensagem indicando que a operação está completa. Select Case Retorna Case "Canceled" MsgBox "Operação Cancelada" Case "Exported" MsgBox "A informação foi exportada" End Select End Sub '------------------------------------------------------------------- Function WriteFile(delimiter As String, quotes As Integer) As String ' Dimensiona variáveis utilizadas. 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 ' Mostrar caixa de diálogo Salvar como com o nome do arquivo .TXT como padrão. ' Testa para ver que tipo de sistema esta macro está sendo executada. 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 o cancelamento foi clicado. If SaveFileName = False Then WriteFile = "Canceled" Exit Function End If ' Obtem o próximo número de arquivo. FNum = FreeFile() ' Abre o nome do arquivo selecionado para saída de dados. Open SaveFileName For Output As #FNum ' Armazena o número total de linhas e colunas em variáveis. TotalRows = Selection.Rows.Count TotalCols = Selection.Columns.Count ' Seleciona a Sheet desejada. Sheets("Plan1").Activate ' Faz um loop em todas as células, da esquerda para a direita e de cima para baixo. For RowNum = 1 To TotalRows For ColNum = 1 To TotalCols With Selection.Cells(RowNum, ColNum) Dim ColWidth As Integer ColWidth = Application.RoundUp(.ColumnWidth, 0) ' Armazena o conteúdo atual das células em uma 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 ' Escreve o conteúdo para o arquivo. ' Com ou sem aspas ao redor da informação da célula. 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 com o progresso. Application.StatusBar = Format((((RowNum - 1) * TotalCols) _ + ColNum) / (TotalRows * TotalCols), "0%") & " Completed." ' Loop para a proxima coluna. Next ColNum ' Adiciona um caractere de avanço de linha no final de cada linha. If RowNum <> TotalRows Then Print #FNum, "" ' Loop para a proxima linha. Next RowNum ' Fecha o arquivo .prn. Close #FNum ' Redefine a barra de status. Application.StatusBar = False WriteFile = "Exported" End Function excel exemplo.xlsx

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

Ebook grátis: Aprenda a ler resistores e capacitores!

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!