Vídeo recomendado
https://youtu.be/diWPPPhW-9E

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

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
RahelCunha
Acabou de chegar
Acabou de chegar
Mensagens: 5
Registrado em: Dom Abr 18, 2021 12:15 pm

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

Mensagem por RahelCunha »

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.

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



Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder