none
Salvar planilha usando código RRS feed

  • Pergunta

  • Boa tarde.
    Desenvolvi uma pequena aplicação em excell (732KB) que funciona a contento.
    Possui vários form's para leitura/escrita.

    Problema: demora cerca de 10 segundos para salvar toda pasta de trabalho.Nesse período há a impressão de travar tudo. É um efeito bastante desagradável.
    Este é o comando para salvar: "ThisWorkbook.Save", como todos sabem.

    Pergunta:
    Há como salvar apenas os dados na planilha, já que não tenho necessidade de salvar os form's toda vez que insiro dados?
    Ex:
    Se eu inserir dados num determinado range, tenho como salvá-lo, somente ele, desprezando
    os formulários?
    A finalidade é tornar mais ágil salvar e passar para outro formulário sem perder muito tempo.
    Poderíam me ajudar nisto?

    Grato
    Edison

    sexta-feira, 27 de julho de 2012 16:34

Respostas

  • Bom dia

    Felipe as instruções para abrir e salvar o arquivo foram suficientes. Ficou ótimo com duas pastas de trabalho. Uma só p/ planilha e outra para formulários. Salva imediato, sem perda de tempo.

    Vou fazer alterações como sugeriste, com um form apenas.

    Por hora está resolvida a dúvida.

    Grato

    Edison  

    • Marcado como Resposta Edsudani quinta-feira, 16 de agosto de 2012 19:53
    quarta-feira, 15 de agosto de 2012 13:07

Todas as Respostas

  • Olá, boa tarde.

    Sua questão pode ser mais rapidamente respondida no fórum de VBA.

    Estou migrando seu post para este fórum especializado.


    Hezequias Vasconcelos

    sexta-feira, 27 de julho de 2012 18:40
    Moderador
  • OK Hezequias, mas como faço para encontrar o subtópico VBA? Não encontrei nenhum link na página

    principal deste fórum e ali postar este tópico. Para acessá-lo desta vez, procurei-o em meus threeds.

    Grato pela ajuda

    Edison

    sexta-feira, 27 de julho de 2012 20:16
  • Olá, boa tarde.

    O endereço é este: 

    http://social.msdn.microsoft.com/Forums/pt-BR/vbapt/threads

    Vou migrar o seu post para facilitar.


    Hezequias Vasconcelos

    sexta-feira, 27 de julho de 2012 20:52
    Moderador
  • Você já está no fórum de VBA. O Hezequias migrou seu tópico para cá, isto é, ele já está no lugar que ele sugeriu.

    Edison, sua Pasta de Trabalho possui muitas fórmulas? Qual é o código que você usa no formulário? Dê mais detalhes para compreender melhor seu problema. De preferência, se possível, disponibilize sua Pasta de Trabalho num site gratuito como SendSpace.com


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    sexta-feira, 27 de julho de 2012 20:55
    Moderador
  • Localizei por meio do Google. Grato, Hezequias.

    Felipe, eu utilizo apenas uma planilha com as fórmulas, coisa simples de fazer.

    Inserir dados na planilha e obenção dos resultados neste caso, se faz por meio de formulários.

    Este pequeno aplicativo tem 22 form's dos quais 4 substituem as tradicionais MSGBOX para tornar o aplicativo mais agradável. Um formulário serve apenas para mostrar os resultados da auditoria e outro

    serve como formulário inicial onde foram criados os botões que abrem todos os demais.

    Quanto às fórmulas são as tradicionais de aritmética -- soma e subtração, usuais em contabilidade, nada excepcional e como disse fazem parte da planilha.

    Segue abaixo o código de apenas um form. Os demais são cópia deste e poucos com pequenas alterações. O procedimento referido é este: Private Sub CmdSalvar_Click()
    ThisWorkbook.Save

    O código certamente não é a excelência de  um programador mas é o que consegui depois de driblar muitas dificuldades.

    Embora não tenha disposto, há também um módulo com código para remover ao caption.

    Em síntese o codigo abaixo é repetido intriro ou em parte 17 vezes para que o aplicativo realize uma auditoria completa.

    Option Explicit

    Dim RetornoFinal As Boolean Dim RetornoSalvar As Boolean Dim RetornoSalva_Sai As Boolean Dim r_OM As Long Dim TotalLinhas_OM As Long Dim Total_OM As String Private Sub Cmd_Sair_Click() 'Salva somente se houve alteração ou insersaão de dados. '--Usando operador AND(E) compara-se duas variáveis. '--O resultado FALSO não permite salvar erroneamente o 'aplicativo ao clicar no botão SAIR, sem inserir dados ou logo após 'abrir o formulário. '--Se não for salvo após a inserção ou correção de dados, o salvamento 'ocorrerá normalmente quado clicar no botão SAIR. '--RetornoSalva_Sai é o retorno do botão Salvar. '--RetornoSalvar é o retorno do Procedimento de Inserção, Limpar e Alteração. '--RetornoFinal é o valor de saída do comparador AND. If RetornoSalva_Sai = False And RetornoSalvar = False Then RetornoFinal = False If RetornoSalva_Sai = False And RetornoSalvar = True Then RetornoFinal = True If RetornoSalva_Sai = True And RetornoSalvar = False Then RetornoFinal = True If RetornoFinal = True Then ThisWorkbook.Save Unload Me FrmRecibos.Show End End Sub Private Sub CmdLimpar_Click() 'Limpa somente o conteúdo das células do range sem alterar a formatação. Worksheets("plan1").Range("A1:A91") = "" 'Limpa o conteúdo do listbox e caixa de texto. ListBox1.Clear TextBox1 = "" 'limpa caixa de texto. RetornoSalvar = True 'A ser comparada no procedimento Cmd_Sair. Me.CmdSalvar.Visible = True End Sub Private Sub CmdSalvar_Click() ThisWorkbook.Save RetornoSalva_Sai = True 'A ser comparada no procedimento Cmd_Sair. End Sub Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim n1 As Variant Dim n3 As Boolean Dim validar As Integer n3 = 0 'Detecta linha vasia na listbox e sai do procedimento. If ListBox1.List(ListBox1.ListIndex) = Empty Then Frm_LinhaSemValor.Show n3 = False Exit Sub End If Linhas: 'Corrige ou anula o valor de uma linha da listbox e grava na 'célula correspondente da planilha. n1 = Application.InputBox(" DIGITE O NOVO VALOR NA FAIXA BRANCA", " ALTERANDO UM DONATIVO") If (n1) = False Then 'Cancela a correção. n3 = False Exit Sub End If If IsNumeric(n1) Then 'Se for Número. validar = 1 Else 'Se for Alfabeto. validar = 2 End If If n1 = "" Then 'Para Anular um Valor. validar = 3 End If Select Case validar 'Seleciona o evento correto. Case validar = 1, validar = 2, validar = 3 'Caso Números Case Is = 1 ListBox1.List(ListBox1.ListIndex) = n1 Cells(ListBox1.ListIndex + 1, "A") = CDbl(ListBox1) n3 = True 'Caso Alfabeto. Case Is = 2 Frm_Mensagem.Show GoTo Linhas 'Caso Anular um Valor. Case Is = 3 Frm_Exclusao.Show If exclusao = False Then Exit Sub Else 'ANULA O VALOR DA LINHA SELECIONADA E SALVA NA PLANILHA. n1 = 0 ListBox1.List(ListBox1.ListIndex) = n1 Cells(ListBox1.ListIndex + 1, "A") = CDbl(ListBox1) n3 = True End If End Select If n3 = False Then RetornoSalvar = False 'A ser comparada no procedimento Cmd_Sair. Else RetornoSalvar = True 'A ser comparada no procedimento Cmd_Sair. Me.CmdSalvar.Visible = True End If 'Atualiza o valor da caixa de texto após a correção. FRM_OM.TextBox1 = Worksheets("plan1").Range("A94").Value End Sub Private Sub Cmd_Inserir_Click() Dim TotalLinhas As Long Dim n1 As Variant ' String n1 = 0 Dim n2 As Boolean n2 = 0 Dim validar As Integer 'INÍCIO DE PREENCHIMENTO. TODAS AS CÉLULAS DEVEM ESTAR VAZIAS. 'Básicamente Selecciona a ultima celula da coluna e 'vai buscar a 1ª celula para cima que se encontra preenchida. 'Depois vai buscar o seu valor e por fim 'desloca-se para baixo de forma a colocar o valor que pretendes. 'O rótulo de linha a seguir simula um loop entre a 1º e a última 'linha vazia, mantendo o InputBox visível p/ todas as linhas. Linhas: 'Verifica quantas linhas tem a coluna para dar tanto para o 2007 como anteriores TotalLinhas = Range("A1:A91").Count 'Vai buscar o valor da ultima celula Range("A" + CStr(TotalLinhas)).End(xlUp).Select 'Varre a coluna "A" em sentido decrescente, ou seja, de baixo para cima. 'Se a última célula estiver preenchida,as anteriores também estarão.Logo, abandona o procedimento. If Range("A91").Value <> "" Then 'Se a última Célula da faixa selecionada não estiver vasia. Frm_Completo.Show n2 = False Exit Sub Else 'Verifica se a 1º célula está vasia. If Range("A1").Value = "" Then 'INICIA O PREENCHIMENTO DA 1º CÉLULA. n1 = Application.InputBox("ESCREVA UM VALOR NA CAIXA DE TEXTO ABAIXO:", _ " DONATIVOS PARA OBRA MUNDIAL") If (n1) = False Then 'Cancela a insersão. n2 = False Exit Sub End If If n1 = "" Then 'Campo sem Valor. n2 = False GoTo Linhas End If If IsNumeric(n1) Then 'Se for Número. validar = 1 Else 'Se for Alfabeto. validar = 2 End If Select Case validar 'Seleciona o evento correto. Case validar = 1, validar = 2 'Caso Números Case Is = 1 ActiveCell.Range("A1").Value = CDbl(n1) 'Ativa a primeira Célula e atribui o valor digitado.'CDbl converte inclusive as casas decimais.Converte para Double. 'Atualiza a ListBox ListBox1.Clear UserForm_Initialize n2 = True GoTo Linhas 'Caso Alfabeto. Case Is = 2 Frm_Mensagem.Show GoTo Linhas End Select End If End If 'Identifica entrada ou alteração de dados p/ salvar ao sair. 'ESTE PROCEDURE NÃO ATIVA O BOTÃO SALVAR SE FOR COLOCADO NO FINAL DESTA 'FOLHA??? NÃO SEI POR QUE. If n2 = False Then RetornoSalvar = False 'A ser comparada no procedimento Cmd_Sair. Else RetornoSalvar = True 'A ser comparada no procedimento Cmd_Sair. Me.CmdSalvar.Visible = True End If 'PREENCHENDO TODAS AS OUTRAS CÉLULAS. If Range("A1").Value <> "" Then 'Verifica se tem dados gravados na 1º célula antes de introduzir algum valor na 2º. n1 = Application.InputBox("ESCREVA UM VALOR NA CAIXA DE TEXTO ABAIXO:", _ " DONATIVOS PARA OBRA MUNDIAL") If (n1) = False Then 'Cancela a insersão. n2 = False Exit Sub End If If n1 = "" Then 'Campo sem Valor. n2 = False GoTo Linhas End If If IsNumeric(n1) Then 'Se for Número. validar = 1 Else 'Se for Alfabeto. validar = 2 End If Select Case validar 'Seleciona o evento correto. Case validar = 1, validar = 2 'Caso Números Case Is = 1 ActiveCell.Offset(1, 0).Value = CDbl(n1) 'Desloca-se para a próxima Célula vasia Ativando-a e Transferindo o valor para ela. 'Atualiza a ListBox ListBox1.Clear UserForm_Initialize n2 = True GoTo Linhas 'Caso Alfabeto. Case Is = 2 Frm_Mensagem.Show GoTo Linhas End Select End If End Sub Private Sub UserForm_Initialize() 'FrmAtivo = 1 'Identifica FRM_OM no Frm_Mensagem. 'Call RemoveCaption(Me) 'Conta o nº de linhas do range. TotalLinhas_OM = Range("A1:A91").Count Range("A" + CStr(TotalLinhas_OM)).End(xlUp).Select 'Atribui o valor da célula à variável. Total_OM = Worksheets("plan1").Range("A94").Value 'Prenche a listbox com os valores da OM. For r_OM = 1 To TotalLinhas_OM ListBox1.AddItem Cells(r_OM, "A") Next r_OM 'Preenche a caixa de texto com o total para a OM. TextBox1 = Total_OM 'Formulário maximizado Application.WindowState = xlMaximized Me.Height = Application.Height Me.Width = Application.Width Me.Left = Application.Left Me.Top = Application.Top 'Botão de Comando Padrão Me.Cmd_Sair.SetFocus End Sub

    Colar o código aqui misturou tudo, mas espero que dê p/ compreender o que tenho em mãos.

    Grato pela ajuda.

    Edison

    sexta-feira, 27 de julho de 2012 21:53
  • Nenhuma dica?

    Edison

    segunda-feira, 30 de julho de 2012 21:33
  • Edison, não tenho como analisar seu código porque ele é muito grande. Seria possível você disponibilizar o seu projeto para eu fazer testes?

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quarta-feira, 1 de agosto de 2012 23:18
    Moderador
  • Boas Felipe. Como posso disponibilizar meu código?

    Não estou prático nisso mas verei se descubro um jeito e retorno.

    Edison

    quinta-feira, 2 de agosto de 2012 13:34
  • Em tempo Felipe. Parece-me que o sendspace é um "arquivo público" nesse caso todos terão acesso ao arquivo ali postado. Se você me informar um e mail válido posso postar o arquivo de forma excusiva caso você permita. caso contrário informo o link do sendspace.

    Grato

    Edison

    quinta-feira, 2 de agosto de 2012 14:17
  • Edison, a função do fórum é que todos participem das discussões.

    Povoe uma cópia da pasta de trabalho com dados fictícios ou reduza-a de forma a retratar exatamente o problema que você está tendo e disponibilize publicamente para todos verem e aumentar suas chances de obter boas respostas.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 2 de agosto de 2012 21:06
    Moderador
  • Bom dia Felipe. Entendo e concordo. De qualquer forma eu postaria o resultado final para beneficiar a todos.

    Mas aqui está o link para baixar o aplicativo, com excessão do formulário splash. 

    Grato

    Edison

    sexta-feira, 3 de agosto de 2012 13:41
  • Com o botão "inserir link" não consegui adicionar a URL para o aplicativo.

    Esta:  http://www.sendspace.com/file/0zctql

    nota: não é preciso preencher com muitos valores, basta uma célula preenchida,

    ao clicar no botão SALVAR demora ~~10 segundos para concluir esse processo.

    Edison

    sexta-feira, 3 de agosto de 2012 13:52
  • Boa tarde

    O arquivo que postei na URL do post anterior contém apenas 1 pasta de trabalho. Por isso resolvi desmembrá-lo em 2 pastas. Uma contém só a planilha, a outra somente os formulários. Ambos não estão disponíveis no link acima.

    Inserí dados diretamente na planilha do 1º livro (Livro_Planilha.xls) e salvei-os. Num clic, o processo foi imediato, sem perda de tempo.

    Repetí o processo na planilha do 2º livro (Livro_Formularios.xls), onde encontram-se somente os formulários. Preenchi apenas uma célula e dei um clic para salvar. Demorou ~~ 10 segundos para realizar o procedimento.

    Com esta comparação pareceu-me apropriado realizar este projetinho em dois livros. Assim os dados serão gravados  e salvos na planilha do 1º livro que contém as operações aritméticas, não havendo necessidade de salvar os formulários junto com os dados da planilha.

    Para ter acesso à planilha do 1º livro escrevi o seguinte comando na folha de procedimentos: ESTA_PASTA_DE_TRABALHO do Livro_Formulario.xls :                  Dim SoPlanilha As Object                    

    Set SoPlanilha = GetObject("C:\Planilha_Separada\Livro_Planilha.xls")

    O nome do arquivo é Livro_Planilha.xls e está na pasta Planilha_Separada na raiz do sistema.

    Mas quando tento abrir retorna o seguinte erro:                                                  Erro em tempo de execução '432' O nome ou a classe do arquivo não foi encontrado durante a operação de automação.

    O que fiz de errado? Ou o que deixei de fazer? Como posso ter acesso à leitura e escrita em outro livro ou outro aplicativo do mesmo tipo?

    Podem me ajudar?

    Edison

    segunda-feira, 6 de agosto de 2012 17:48
  • Edilson,

    Você está certo. Sua Pasta de Trabalho está lenta porque tem muitos formulários.

    No entanto, vejo que está buscando uma alternativa para contornar o problema. O que pretende fazer exatamente? Abrir outra Pasta de Trabalho e salvar os dados lá? Acho que dessa forma seria mais lento ainda.

    Ao analisar sua Pasta de Trabalho, a primeira ideia que tive para melhora-la é reduzir o número de formulários. Isso não seria difícil. Veja, por exemplo, a Pasta de Trabalho aqui: https://skydrive.live.com/redir?resid=FB206A2D510E0661!449


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    terça-feira, 7 de agosto de 2012 00:05
    Moderador
  • Bom dia Felipe.

         De fato! Se eu conseguir introduzir os dados em outra pasta de trabalho ("Livro_Planilha.xls") salvando somente essa pasta (ou seja, a planilha sem os formulários) imagino que resolveria o problema.  

      Note que a idéia é de que os formulários contidos em Livro_Formularios.xls sirvam apenas como interface entre o usuário e a planilha. Nada será salvo nestes formulários.       

    O aplicativo como está, roda normalmente e pode ser utilizado sem problemas. Enquanto isso como alternativa estuarei sua sugestão --- Salvei cópia do arquivo.

    De qualquer forma se puderes me ajudar na proposta de livros separados eu te agradeço.

    Edison                           

    terça-feira, 7 de agosto de 2012 15:58
  • Boas.

    Recorri à ajuda do excel e com base num exemplo da função GetObject fiz o seguinte código num módulo:

    Option Explicit

    'Declara rotinas API necessárias para Função GetOject
    Declare Function Findwindow Lib "user32" Alias _
    "FindWindowA" (ByVal lpClassName As String, _
    ByVal lpWindowName As Long) As Long

    Declare Function SendMessage Lib "user32" Alias _
    "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long

    _________________________________________________________
    Sub MostraExcel()
    Dim SoPlanilha As Object 'Contém referência ao Excel.
    Dim ExcelNaoEstavaRodando As Boolean 'Sinal p/ liberação final.
    'Checa p/ ver se há aplicativo Excel Rodando.
    On Error Resume Next
    'Esta função retorna uma referência p/ uma instância do aplicativo.
    'Se não estiver rodando retorna erro.
    Set SoPlanilha = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then ExcelNaoEstavaRodando = True
    Err.Clear 'Se ouver erro, limpa objeto ERR.
    'Se o Excel está rodando, entra na tabela do objeto em execução.
    DetectExcel
    'A variável de objeto refere-se ao arquivo que desejo ver.
    Set SoPlanilha = GetObject("C:\Planilha_Separada\Livro_Planilha.xls")
    'Exibindo o arquivo que usa a coleção do Windows da referência
    'do objeto SoPlanilha.
    SoPlanilha.Application.Visible = True
    SoPlanilha.Parent.Windows(1).Visible = True

    'Daqui para frente manipulo meus dados.

    End Sub

    ________________________________________________________

    Sub DetectaExcel()

    'Detecta e registra um aplicativo em execução.
    Const WM_USER = 1024
    Dim hWnd As Long
    'Se executando excel, chamada de API retorna gerenciamento.
    hWnd = Findwindow("XLMAIN", 0)
    If hWnd = 0 Then 'Se não está em execução.
        Exit Sub
     Else 'Se está em execução.
     'Insere o arquivo na tabela do objeto em execução.
     SendMessage hWnd, WM_USER + 18, 0, 0
     End If

    End Sub

    _______________________________________________________

    Mas que retorna o seguinte erro :

                                        Erro de Compilação

                                        Nome repetido encontrado: FindWindow

    O primeiro bloco Declare Function permanece realçado.

    Queria testar o acesso ao arquivo Livro_Planilha.xls mas não deu certo. Podem me ajudar?

    Edison

    terça-feira, 7 de agosto de 2012 19:21
  • Ainda acho que você deveria reduzir - e urgentemente - os formulários da sua pasta de trabalho. É a primeira coisa que deve fazer.

    Sobre o código de manipular outra pasta de trabalho, você só precisa usar os métodos GetObject e CreateObject quando quer abrir uma pasta de trabalho, mas não há uma instância da aplicação Excel aberta. Como seu código roda do Excel, pode usar somente:

    Sub Abrir()
        Dim wb As Workbook
        Set wb = Workbooks.Open("c:\felipe\pastadetrabalho.xlsx")
    End Sub
    
    Sub Manipular()
        Dim wb As Workbook
        Set wb = Workbooks("pastadetrabalho.xlsx")
        
        wb.Sheets("Plan1").Cells(5, 3) = "Benzadeus"
    End Sub
    
    Sub Fechar()
        Dim wb As Workbook
        Set wb = Workbooks("pastadetrabalho.xlsx")
        
        wb.Close SaveChanges = True 'para salvar alterações
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quarta-feira, 8 de agosto de 2012 00:40
    Moderador
  • OK Felipe.

    Essa foi a primeira idéia que me ocorreu no início do projeto, mas que abandonei devido a muitas dificuldades encontradas na ocasião. Mas vou retomar sua sugestão a sério. já agora vou "matar" a curiosidade só p/ ver o resultado final com formulários separados.

    Edison

    quarta-feira, 8 de agosto de 2012 11:49
  • Bom dia

    Felipe as instruções para abrir e salvar o arquivo foram suficientes. Ficou ótimo com duas pastas de trabalho. Uma só p/ planilha e outra para formulários. Salva imediato, sem perda de tempo.

    Vou fazer alterações como sugeriste, com um form apenas.

    Por hora está resolvida a dúvida.

    Grato

    Edison  

    • Marcado como Resposta Edsudani quinta-feira, 16 de agosto de 2012 19:53
    quarta-feira, 15 de agosto de 2012 13:07