Neri Schuck

Quem quiser acompanhar pode ser no link:https://www.hardware.com.br/comunidade/backup-base/1498273/#post8135709

Como eu faço o backup se a base de dados é separado dos formulários? Tenho o meu arquivo onde tenho todos os formulários e outra base com os dados. Se colocar o meu backup ele fará cópia dos formulários, mas eu quero fazer dos dados... vou colocar abaixo o código do meu backup atual, baseado no link... Se alguém puder me ajudar, agradeço....

O código abaixo eu encontrei parte na internet e adaptei parte para a minha necessidade. Porém ele faz cópia somente do arquivo ativo. O que eu preciso é fazer cópia de outra base. Assim....

Tenho dois arquivos:
- um com os formulários
- um com os dados

>> a arquivo de dados eu não abro manualmente, somente pelos formulários. Então, com os formulários abertos, eu quero uma opção que acesse o arquivo de dados e faça uma cópia de todo o arquivo para um outro local (para a paste Backup - por exemplo).

Alguém me ajuda a adaptar a minha necessidade?

Public Sub Backup()
Dim Copia As String
Dim caminho As String
Dim NomeArquivo As String
Dim Resp As String

    Dim y, X As String
    Dim a As Integer
        y = ActiveWorkbook.Name
        a = Len(y)
            X = Left(y, (Len(y) - 5))
           

MsgBox "Este módulo serve para fazer cópia dos dados do Programa." & vbCrLf & _
"É recomendável fazer a cópia diariamente!" & vbCrLf & _
" " & vbCrLf & _
"Este comando irá finalizar o Programa. Após a execução poderá ser reinicializado normalmente.", vbInformation, "Backup"

NomeArquivo = ThisWorkbook.Name

caminho = Application.ThisWorkbook.Path & "\Backup\"
Copia = caminho & X & " - " & Plan12.Cells(202, 3) & ".xlsm"


Resp = MsgBox("Deseja efetuar cópia de segurança?" & vbCrLf & _
"A cópia levará alguns segundos para terminar!", vbYesNo + vbDefaultButton2, "Controle Caixa.xlsm")


If Resp = vbNo Then
MsgBox "Backup cancelado pelo usuário!", vbInformation, "Controle Caixa"

Exit Sub
End If


Application.DisplayAlerts = False
ThisWorkbook.Save
ThisWorkbook.SaveAs Copia
Application.Quit


End Sub

Insiro em anexo 2 formulários:
1 - Pesquisa de Clientes
2 - Cadastro de Dados

Quando quero cadastrar dados, clico no sinal de "+" no arquivo "Cadastro de Dados" e escolho o cliente.
Ao escolher o cliente 2 chamado "Auto" funciona corretamente, porém na hora de salvar ele troca o cliente. Motivo que ele faz isto: O comando não salva o nome do cliente, e sim substitui pelo codigo do mesmo que está no cadastro do cliente. 
Por exemplo: Se escolher o cliente "Auto" (Cliente 2) e salvar os dados, ele teria que salvar o código "2". 
Mas não é isto que acontece. Ele vai na relação dos clientes e procura a palavra "Auto" e o primeiro que ele encontrar ele pega o código. Vejam que o cliente 1 tem o nome de "Auto Peças", ou seja, tem a palavra Auto e por este motivo ele salva como cliente 1.

O codigo que faz a procura e salva o codigo é este:

If Me.txtcliente.Text = "" Then
.Cells(indice, ColCliente).Value = "NAO INFORMADO"
Set wsCliente = ThisWorkbook.Worksheets("clientes")
With wsCliente.Range("B1:B65000")
Set X = .Find("NAO INFORMADO", LookIn:=xlValues)
If Not X Is Nothing Then
cliente = wsCliente.Rows(X.Row).Value
End If
End With
.Cells(indice, ColCliente).Value = cliente
indiceRegistro = indice ' posiciona no lancamento correto para evitar erros
Set wsCliente = Nothing
Else
Set wsCliente = ThisWorkbook.Worksheets("clientes")
With wsCliente.Range("B1:B65000")
Set X = .Find(Me.txtcliente.Text, LookIn:=xlValues)
If Not X Is Nothing Then
cliente = wsCliente.Rows(X.Row).Value
End If
End With
.Cells(indice, ColCliente).Value = cliente
indiceRegistro = indice ' posiciona no lancamento correto para evitar erros
Set wsCliente = Nothing
End If

Como poderia fazer para evitar este erro?

.

Laerte Agora entendi o teu exemplo.... fui olhar novamente.

Obrigado...vou usar.

Quando clico em calcular no userform no Excel ele mostra a mensagem que destaquei abaixo. 

Como eu faço para que ela apareça no meu userform?Qual a linha de comando? pode ser em Textbox, label, etc.... gostaria de mostrar ela, igual ao que destaquei abaixo, porém no meu userform....

Certo...já utilizo desta forma em alguns trabalhos....Vou ver como ajustar...

muito obrigado.

Ok... Mas como este programa é operado por outra pessoa, não deixei acesso para que ela consiga visualizar planilha.

Agora pergunto pois realmente não sei: teria como deixar uma planilha dinâmica como base e acessar estes dados por Listview?

Vou dar uma rápida explicada da planilha, sem a necessidade de visualizar ela.

Tenho a opção de comparar os meses de um ano e de outro ano.

No ano 1 (tenho as opções de escolher 1 mês ou até 12 meses).  Igualmente será para o ano 2 para comparar com o primeiro.

1)A quantidade de cálculos é enorme, sendo que cada cliente tem os 24 meses lado-a-lado (2 anos dos comparativos)

2)Em cada mês (para cada cliente) tenho a opções de 5 tipos de seguros o que vai fazendo com que  a planilha fique pesada

3)Exemplo o mês Janeiro do primeiro ano: Usa o somase, comparando se o ano estiver marcado. Após isto ele tem que usar o somase para cada um dos 5 tipos de seguros (neste soma-se tem que ver o ano, mês, cliente, tipo de seguro).

Abaixo o calculo de Janeiro para um cliente. Isto se repete 24 vezes para cada cliente. (Multiplica por 400 clientes......!!!!)

=SE(Auxiliar!$B$52=VERDADEIRO;SE(Auxiliar!$B$46=VERDADEIRO;SOMASES(Dados!$G:$G;Dados!$B:$B;Auxiliar!$A$52;Dados!$C:$C;Auxiliar!$B$51;Dados!$D:$D;A2;Dados!$F:$F;Auxiliar!$A$46);0)+SE(Auxiliar!$B$47=VERDADEIRO;SOMASES(Dados!$G:$G;Dados!$B:$B;Auxiliar!$A$52;Dados!$C:$C;Auxiliar!$B$51;Dados!$D:$D;A2;Dados!$F:$F;Auxiliar!$A$47);0)+SE(Auxiliar!$B$48=VERDADEIRO;SOMASES(Dados!$G:$G;Dados!$B:$B;Auxiliar!$A$52;Dados!$C:$C;Auxiliar!$B$51;Dados!$D:$D;A2;Dados!$F:$F;Auxiliar!$A$48);0)+SE(Auxiliar!$B$49=VERDADEIRO;SOMASES(Dados!$G:$G;Dados!$B:$B;Auxiliar!$A$52;Dados!$C:$C;Auxiliar!$B$51;Dados!$D:$D;A2;Dados!$F:$F;Auxiliar!$A$49);0)+SE(Auxiliar!$B$50=VERDADEIRO;SOMASES(Dados!$G:$G;Dados!$B:$B;Auxiliar!$A$52;Dados!$C:$C;Auxiliar!$B$51;Dados!$D:$D;A2;Dados!$F:$F;Auxiliar!$A$50);0);0)

É bem complexo. Talvez tenha outra maneira de fazer este cálculo. Mas não sei como faria.

Mas sobre a postagem de cálculo manual...ele já está pois atualiza somente quando clico no botão "Atualizar"

Novamente agradeço a colaboração de ambos os amigos.... sempre é importante trocar idéias. Vou ver como fazer. Agora tenho opções.

Abraço a todos e ótima semana para nós todos.

Laerte

Ótimo esclarecimento... Muito obrigado. Provavelmente outras pessoas já tiveram o mesmo problema.Abraço

Amigos, minha máquina tem estas opções marcadas para o funcionamento da minha macro. Quando passei para a máquina do cliente não tinha as opções "Microsoft Office 16.0 Object Library" e "Microsoft Excel 16.0 Object Library". Ao invés disto, tinha o 15.0.

Em consequência disto não funcionou o pesquisar. Não trazendo os dados... Acredito que deva alterar esta parte....

Alguém sabe o que fazer?

Consegui.... Alterei o Provider para .Provider = "Microsoft.ACE.OLEDB.12.0"

Segue em anexo

Descrição do Problema.docx

teste (2).rar

Coloquei um exemplo no link: https://www.dropbox.com/home/Teste Excel

Se quiser olhar.. fiz uma descrição em Word (tb está lá).... 

Sem stress.... se conseguir, ótimo. Se não conseguir, tb está ótimo....Mas já que pediu, disponibilizei. Obrigado

Amigo vou ajustar.... mas atualmente com 400 clientes leva em torno de 40 segundos. Amanhã ou depois terá 500..600...clientes e o tempo terá que ser alterado manualmente. Exatamente isto que eu queria evitar pois a planilha fica com o usuário, e eu não acompanho a quantidade de clientes ... mas vou ver o que faço.

Abraço e obrigado por ajudar.

Otimo meu amigo (até pensei nisto)

Acontece que vou inserindo dados e o tempo vai alterando....Por este motivo pensei no "Calculando" que aparece no excel....

Alguém sabe como eu faço para que no userform Excel VBA apareça aquela mensagem que fica na parte inferior à direita da planilha do Excel que diz: "Aguarde....Processando"..... o motivo é que, ao marcar o meu formulário leva alguns segundos calculando e o formulário ocupa a tela inteira. Caso mostre que está processando, o usuário não irá clicar eu outros pontos.....

Amigo... vou fazer os testes. Muito obrigado. Se precisar novamente, eu posto. Abraço

vou anexar...veja as setas; queria (se possivel) o gráfico fosse expandido também....

teste.rar

Amigo Osvaldo

Não consegui ajustar... vou refazer os testes mais tarde...

Obrigado

Coloquei um Userform para ser tela cheia pelo comando:

'Maximizar na tela
Dim lngWinState As XlWindowState
With Application
.ScreenUpdating = False
lngWinState = .WindowState
.WindowState = xlMaximized
Me.Move 0, 0, .Width, .Height
.WindowState = lngWinState
.ScreenUpdating = True
End With
'fim

este transforma o form e fica show.

Acontece que no meu form inseri uma Image para colocar um gráfico. Este não expande proporcional. será que alguém possui um código que faça isto?

Obrigado Edson... Vou fazer os testes, depois disto irei postar o resultado. Abraço

Meu amigo Edson, que bom que você está aí para ajudar os outros. 

Na máquina deles e na minha é Excel 32 Bits.

Estava pensando o que poderia ser, pois sempre funcionava. Acontece que na minha máquina passei de Excel 2010 para 2016. Tem grandes chances de ser isto. Abraço amigo

Eu desenvolvi um programa em Vba na minha máquina e passei para o cliente e funcionou normalmente.

Agora para atualizar, peguei o arquivo da máquina do cliente e coloquei na minha. Alterei e passei novamente para a máquina do cliente. Mas dá erro na DLL. Acusa o erro no inicio do code abaixo. Alguém já teve este problema?

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

 On Error Resume Next
       
    ' Começa ordenar o listview pela coluna clicada
    
    With ListView1
    
        ' Mostrar o cursor ampulheta enquanto faz o filtro
        
        Dim lngCursor As Long
        lngCursor = .MousePointer
        .MousePointer = vbHourglass
        
        'A rotina impede que o controle ListView faça atualização na tela
        'Isto é para esconder as mudanças que estão sendo feitas aos listitems
        'E também para acelerar o código
        
        'Verifique o tipo de dados da coluna de ser classificada,
        'para nomeá-la em conformidade
        
        Dim l As Long
        Dim strFormat As String
        Dim strData() As String
        
        Dim lngIndex As Long
        lngIndex = ColumnHeader.Index - 1
    
        '***************************************************************************
        ' Ordenar por data.
        
        Select Case UCase$(ColumnHeader.Tag)
        Case "DATE"
        
            
            
            strFormat = "YYYYMMDDHhNnSs"
        
            'O Loop através dos valores desta coluna organizam
            'As datas de modo que eles possam ser classificados em ordem alfabética,
        
            With .ListItems
                If (lngIndex > 0) Then
                    For l = 1 To .Count
                        With .Item(l).ListSubItems(lngIndex)
                            .Tag = .Text & Chr$(0) & .Tag
                            If IsDate(.Text) Then
                                .Text = Format(CDate(.Text), _
                                                    strFormat)
                            Else
                                .Text = ""
                            End If
                        End With
                    Next l
                Else
                    For l = 1 To .Count
                        With .Item(l)
                            .Tag = .Text & Chr$(0) & .Tag
                            If IsDate(.Text) Then
                                .Text = Format(CDate(.Text), _
                                                    strFormat)
                            Else
                                .Text = ""
                            End If
                        End With
                    Next l
                End If
            End With
            
            ' Ordenar a lista em ordem alfabética por esta coluna
            
            .SortOrder = (.SortOrder + 1) Mod 2
            .SortKey = ColumnHeader.Index - 1
            .Sorted = True
            
            ' Restaura os valores anteriores das "células" nesta
            ' Coluna da lista das tags, e também restaura
            ' as tags para os valores originais
            
            With .ListItems
                If (lngIndex > 0) Then
                    For l = 1 To .Count
                        With .Item(l).ListSubItems(lngIndex)
                            strData = Split(.Tag, Chr$(0))
                            .Text = strData(0)
                            .Tag = strData(1)
                        End With
                    Next l
                Else
                    For l = 1 To .Count
                        With .Item(l)
                            strData = Split(.Tag, Chr$(0))
                            .Text = strData(0)
                            .Tag = strData(1)
                        End With
                    Next l
                End If
            End With
            
        '***************************************************************************
        'Ordenar Numericamente
        
        Case "NUMBER"
        
       
            strFormat = String(30, "0") & "." & String(30, "0")
        
            ' Loop através dos valores desta coluna. Ordena os valores de modo que eles
            ' Podem ser classificados em ordem
        
            With .ListItems
                If (lngIndex > 0) Then
                    For l = 1 To .Count
                        With .Item(l).ListSubItems(lngIndex)
                            .Tag = .Text & Chr$(0) & .Tag
                            If IsNumeric(.Text) Then
                                If CDbl(.Text) >= 0 Then
                                    .Text = Format(CDbl(.Text), _
                                        strFormat)
                                Else
                                    .Text = "&" & InvNumber( _
                                        Format(0 - CDbl(.Text), _
                                        strFormat))
                                End If
                            Else
                                .Text = ""
                            End If
                        End With
                    Next l
                Else
                    For l = 1 To .Count
                        With .Item(l)
                            .Tag = .Text & Chr$(0) & .Tag
                            If IsNumeric(.Text) Then
                                If CDbl(.Text) >= 0 Then
                                    .Text = Format(CDbl(.Text), _
                                        strFormat)
                                Else
                                    .Text = "&" & InvNumber( _
                                        Format(0 - CDbl(.Text), _
                                        strFormat))
                                End If
                            Else
                                .Text = ""
                            End If
                        End With
                    Next l
                End If
            End With
            
            ' Ordenar a lista em ordem alfabética por esta coluna
            
            .SortOrder = (.SortOrder + 1) Mod 2
            .SortKey = ColumnHeader.Index - 1
            .Sorted = True
            
                      
            With .ListItems
                If (lngIndex > 0) Then
                    For l = 1 To .Count
                        With .Item(l).ListSubItems(lngIndex)
                            strData = Split(.Tag, Chr$(0))
                            .Text = strData(0)
                            .Tag = strData(1)
                        End With
                    Next l
                Else
                    For l = 1 To .Count
                        With .Item(l)
                            strData = Split(.Tag, Chr$(0))
                            .Text = strData(0)
                            .Tag = strData(1)
                        End With
                    Next l
                End If
            End With
        
        Case Else   ' Assume ordenação como string
            
            
        
            .SortOrder = (.SortOrder + 1) Mod 2
            .SortKey = ColumnHeader.Index - 1
            .Sorted = True
            
        End Select
   
        .MousePointer = lngCursor
    
    End With
    



End Sub

E se você colocar um lançamento abaixo ao outro somente a medida que vai acontecendo e fazer um soma-se depois. Poderia criar um formulário para alimentar, ou até direto na planilha.

Exemplo:

Dia     funcion.   tipo     qte

01/06  José        Frente 4

02/06  Pedro      Vendas 2

03/06  Pedro      Frente  3

e no final fazer um soma-se. Acho que vai sei o mais fácil.

pensa no caso