openFileDialog já abre arquivo CSv com data em formato americano.

[Rudieres Cunha]

 

Bom dia!

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.

PlanilhaModelo

ArquivoRodarNaPlanilha

 

Segue código e arquivos modelo para testes em anexo.

Muito obrigado.

 

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

 

Editado Abril 5, 2023 por Rudieres Cunha
Erro onde coloquei os anexos.