Por favor, me ajudem.
Já tentei de tudo e fiz diversas pesquisas sem solução.
Tenho um código vba todo pronto. Porém, o único problema, é que o arquivo original é em formato csv/txt. Quando abro o arquivo clicando normalmente, ele não inverte as datas na coluna F por exemplo. Porém, ao utilizar o codigo VBA ele inverte logo ao realizar o comando para abrir o arquivo, impossibilitando de aplicar soluções como vba.format, format, cdate, etc....
Impossibilita porque ele altera a data só até o dia 12 de cada mês, porque não existe mês 13..Então é como se ficassem 2 formatos no arquivos, um brasileiro e 1 americano. Ou seja, ele já abre o arquivo lendo o mês errado.
Segue código e arquivos modelo para testes em anexo.
Muito obrigado.
PlanilhaModelo
ArquivoRodarNaPlanilha
Código: Selecionar todos
Public CaminhoArquivo, NomeDoArquivo, NomeDoArquivoComExtensao, Aba As Variant
'Public: Declaração de variável global, ou seja, disponível para qualquer rotina deste projeto.
Option Explicit
Sub AtualizarmovT99Nv()
Call OpenFileDialog
End Sub
Public Function OpenFileDialog() As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveSheet.DisplayPageBreaks = False 'Desabilita as quebras de páginas
Dim Filter As String, Title As String
Dim FilterIndex As Integer
Dim Filename As Variant
Dim Aba As Variant
' Define o filtro de procura dos arquivos
Filter = "Arquivos Excel (*.xls*),*.xl*,"
' O filtro padrão é *.*
FilterIndex = 4
' Define o Título (Caption) da Tela
Title = "Selecione o arquivo correspondente ao Cadastro de Produtos"
' Define o disco de procura
ChDrive ("C")
ChDir ("C:\Users")
With Application
' Abre a caixa de diálogo para seleção do arquivo com os parâmetros
Filename = .GetOpenFilename(Filter, FilterIndex, Title)
' Reseta o Path
ChDrive (Left(.DefaultFilePath, 1))
ChDir (.DefaultFilePath)
End With
' Abandona ao Cancelar
If Filename = False Then
MsgBox "Nenhum arquivo foi selecionado."
Exit Function
End If
' Retorna o caminho do arquivo
OpenFileDialog = Filename
CaminhoArquivo = Filename
Dim Pergunta As VbMsgBoxResult
Pergunta = MsgBox("Deseja realmente abrir o arquivo " & CaminhoArquivo & "?", vbYesNo + vbQuestion, "Abrir Arquivo")
If Pergunta = vbYes Then
'Apagar a primeira linha para subscrever nova ramificação de pasta
Sheets("CaminhoArquivo").Visible = True
Sheets("CaminhoArquivo").Select
Rows("1:1").Select
Selection.Delete Shift:=xlUp
'Transcreve o endereço do arquivo para a celula a1
Sheets("CaminhoArquivo").Range("A1").Value = CaminhoArquivo
Sheets("CaminhoArquivo").Range("A1").Select 'Clica na celula do A1
'Procedimento texto para colunas
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="\", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=True
'Procedimento para retornar somente o nome do arquivo
'A função replace equivale a substituir
NomeDoArquivo = VBA.Replace(VBA.Replace(Sheets("CaminhoArquivo").Cells(1, Application.CountA(Sheets("CaminhoArquivo").Range("1:1"))).Value, ".xls", ""), ".xlsx", "")
Sheets("CaminhoArquivo").Activate
ActiveWindow.SelectedSheets.Visible = False
Sheets("movT99").Activate
Else
MsgBox "Proceder nova abertura", vbCritical, "Abrir arquivo"
End If
Call FormatarCadastro
'Call Atualizar
MsgBox ("movT99 atualizada com sucesso!")
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Function
Sub FormatarCadastro()
Dim NomeDesseArquivo, TotalLinhasCustInv, DataHora, Linhas, _
TotalLinhasmovT99, TotalLinhasFormulas, Aba, TotalLinhas As Variant
Dim CaixaTexto As String
'Capta o nome deste projeto, ou seja, 02 fevereiro.xlsm
NomeDesseArquivo = ActiveWorkbook.Name
'Limpar área movT99 analítico
Windows(NomeDesseArquivo).Activate
'Procedimento para abrir pasta de trabalho
Workbooks.Open Filename:=CaminhoArquivo
NomeDoArquivoComExtensao = ActiveWorkbook.Name
Aba = ActiveSheet.Name
TotalLinhas = Sheets(Aba).Range("A" & Rows.Count).End(xlUp).Row
Sheets(Aba).Activate
'--------------------------------------------------------------------------------------------------------------
'Formatar arquivo para copiar
Range("A:A,E:E,H:H,J:J,K:K,L:L,M:M,N:N,P:P,Q:Q,U:X").Delete Shift:=xlToLeft
'--------------------------------------------------------------------------------------------------------------
TotalLinhas = Sheets(Aba).Range("A" & Rows.Count).End(xlUp).Row
Range("A2:J" & TotalLinhas).Copy
Windows(NomeDesseArquivo).Activate
Sheets("movT99").Activate
TotalLinhasmovT99 = Sheets("movT99").Range("N" & Rows.Count).End(xlUp).Row
TotalLinhasFormulas = Sheets("movT99").Range("K" & Rows.Count).End(xlUp).Row
Range("N" & TotalLinhasmovT99 + 1).PasteSpecial
'DoEvents 'Aguardar o processamento anterior para processar a px linha
Windows(NomeDoArquivoComExtensao).Activate
ActiveWindow.Close savechanges:=False
TotalLinhasmovT99 = Sheets("movT99").Range("N" & Rows.Count).End(xlUp).Row
'Range(Cells(TotalLinhasFormulas + 1, 1), Cells(TotalLinhasmovT99, 1)).Value = CaixaTexto
'Range(Cells(TotalLinhasFormulas + 1, 1), Cells(TotalLinhasmovT99, 1)) = VBA.Format(CaixaTexto, "mm/dd/yyyy")
'Application.Calculation = xlCalculationManual
' Range(Cells(TotalLinhasFormulas + 1, 9), Cells(TotalLinhasmovT99, 9)).Value = "=IF(AND(ISNA(IF(OR(RC[-6]=11,RC[-6]=0),0,VLOOKUP(movT99!RC[-6],Tabela1[[#All],[ITEM]:[CUSTO_INV]],7,0)*movT99!RC[-4])),RC[-6]<>11,RC[-6]<>0),""Atualizar movT99 custo"",IF(OR(RC[-6]=11,RC[-6]=0),0,VLOOKUP(movT99!RC[-6],Tabela1[[#All],[ITEM]:[CUSTO_INV]],7,0)*movT99!RC[-4]))"
' Range(Cells(TotalLinhasFormulas + 1, 10), Cells(TotalLinhasmovT99, 10)).Value = "=IF(AND(ISNA(IF(OR(RC[-7]=11,RC[-7]=0),0,INDEX(Tabela1[[#All],[LINHA RESUMIDA]],MATCH(RC[-7],Tabela1[[#All],[ITEM]],0)))),RC[-7]<>11,RC[-7]<>0),""Atualizar movT99 Linha Resumida"",IF(OR(RC[-7]=11,RC[-7]=0),"""",INDEX(Tabela1[[#All],[LINHA RESUMIDA]],MATCH(RC[-7],Tabela1[[#All],[ITEM]],0))))"
' Range(Cells(TotalLinhasFormulas + 1, 11), Cells(TotalLinhasmovT99, 11)).Value = "=IFERROR(IFERROR(VLOOKUP(RC[-9],Tabela2[#All],2,0),VLOOKUP(RC[-4],Tabela2[#All],2,0)),RC[-4])"
'Range("I" & TotalLinhasFormulas + 1).Value = "=IF(AND(ISNA(IF(OR(RC[-6]=11,RC[-6]=0),0,VLOOKUP(movT99!RC[-6],Tabela1[[#All],[ITEM]:[CUSTO_INV]],7,0)*movT99!RC[-4])),RC[-6]<>11,RC[-6]<>0),""Atualizar movT99 custo"",IF(OR(RC[-6]=11,RC[-6]=0),0,VLOOKUP(movT99!RC[-6],Tabela1[[#All],[ITEM]:[CUSTO_INV]],7,0)*movT99!RC[-4]))"
'Range("J" & TotalLinhasFormulas + 1).Value = "=IF(AND(ISNA(IF(OR(RC[-7]=11,RC[-7]=0),0,INDEX(Tabela1[[#All],[LINHA RESUMIDA]],MATCH(RC[-7],Tabela1[[#All],[ITEM]],0)))),RC[-7]<>11,RC[-7]<>0),""Atualizar movT99 Linha Resumida"",IF(OR(RC[-7]=11,RC[-7]=0),"""",INDEX(Tabela1[[#All],[LINHA RESUMIDA]],MATCH(RC[-7],Tabela1[[#All],[ITEM]],0))))"
'Range("K" & TotalLinhasFormulas + 1).Value = "=IFERROR(IFERROR(VLOOKUP(RC[-9],Tabela2[#All],2,0),VLOOKUP(RC[-4],Tabela2[#All],2,0)),RC[-4])"
Range("K" & TotalLinhasFormulas + 1).Value = "=HOUR(RC[6])"
Range("L" & TotalLinhasFormulas + 1).Value = "=INT(RC[5])"
Range("M" & TotalLinhasFormulas + 1).Value = "=RC[1]&RC[2]&RC[9]"
Range(Cells(TotalLinhasFormulas + 1, 11), Cells(TotalLinhasFormulas + 1, 13)).Copy Destination:=Range(Cells(TotalLinhasFormulas + 2, 11), Cells(TotalLinhasmovT99, 13))
Calculate
'Application.Calculation = xlCalculationAutomatic
Range(Cells(TotalLinhasFormulas, 11), Cells(TotalLinhasmovT99, 13)).Value = Range(Cells(TotalLinhasFormulas, 11), Cells(TotalLinhasmovT99, 13)).Value
End Sub