Marcelo Lisboa Conde

Desculpem insistir no assunto, mas alguém pode me ajudar com este problema?

segue a planilha. Se puder ajudar veja por favor as macros de inclusão e exclusão de cadastro. Sem querer abusar tem também a Private Sub Worksheet_Change que bato cabeça há 2 meses com essas 3 macros e não saio do lugar. Desde já agradeço qualquer ajuda. Controle_Escritorio_Juridico.zip

Como bloquear a repetição de várias linhas em uma combobox? A combobox está direto na célula e sempre que excluo um cadastro fica repetindo várias linhas do cadastro no final da lista após atualizar. E também quando incluo um cadastro a combobox fica vazia após finalizar a inclusão. Utilizo várias sub para completar o processo tais como: colocar em letra maiúscula, ordenar a coluna na aba do banco de dados, atualizar a combobox, criar ou excluir pasta no Windows explorer e salvar cadastro em PDF. Todos os processos são executados através da função Call na sub cadastrar ou excluir. No caso da inclusão fica como se estivesse em um Loop infinito, porém não tem nenhuma função Do while. Como posso solucionar estas 2 questões no VBA? Segue os comandos da sub cadastrar: Private Sub CommandButton2_Click() ' ' botão Cadastrar ' Application.ScreenUpdating = False ' Dim X, Y, Z, W, fso X = Range("I10").Value ' X recebe nome contido na célula "I10" Y = Range("E8").Value ' Y recebe o ano contido na célula "E8" Z = Range("F8").Value ' Z recebe o mês contido na célula "F8" W = Range("G8").Value ' Y recebe o dia contido na célula "G8" ' X = Range("I10").Value ' X recebe nome contido na célula "I10" ' If X = "" Then 'Rotina checa para ver se há nomes selecionados ' MsgBox "Nenhum nome informado. Processo abortado.", vbOKOnly, "CONTROLE DE ESCRITÓRIO JURÍDICO" Range("A1").Select ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True ' protege a planilha Exit Sub ' End If ' Set fso = CreateObject("Scripting.FileSystemObject") 'Criar objeto ' If fso.FolderExists("D:\Controle Escritorio Juridico\" & X & " " & Y & "_" & Z & "_" & W) Then MsgBox "PASTA CLIENTE já existe. Utilize a opção de ATUALIZAR DADOS ou crie novo cadastro com data diferente da existente.", vbOKOnly, "CONTROLE DE ESCRITÓRIO JURÍDICO" Range("E10").Select Exit Sub ' End If ' Call Uppercase Call Todas_PrimeirasLetras_Maius Call AdicCli Call AdicPCon Call AdicProces Call GravarDados ' Call CriarPastas Call SalvaEmPDF ' MsgBox "Cadastro finalizado com sucesso.", vbOKOnly, "CONTROLE DE ESCRITÓRIO JURÍDICO" ' Call LimpaDadosExcluidos ' cmbBusca.Value = "" ' Application.ScreenUpdating = True ' End Sub e os comandos da sub excluir: Private Sub btExcluir_Click() ' ' exclui dados do registro ' Application.ScreenUpdating = False ' Dim W As Worksheet Dim Nome As String ' Set W = Sheets("Registro") ' Sheets("Registro").Visible = True ' reexibe planilha ActiveWindow.SmallScroll Down:=-6 ActiveSheet.Unprotect ' desprotege a planilha ' Nome = Range("I10").Value ' If Nome = "" Then 'Rotina checa para ver se há nomes selecionados ' MsgBox "Nenhum nome selecionado. Processo abortado.", vbOKOnly, "CONTROLE DE ESCRITÓRIO JURÍDICO" Range("A1").Select ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True ' protege a planilha Exit Sub ' End If ' Dim Msg, Style, Title, Help, Ctxt, Response, MyString Msg = "Os dados do cliente selecionado serão APAGADOS definitivamente. CONFIRMA a exclusão?" ' Define a mensagem Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define os botões Title = "CONTROLE DE ESCRITÓRIO JURÍDICO" ' Define o título Response = MsgBox(Msg, Style, Title) If Response = vbYes Then ' O usuário escolheu Sim MyString = "Sim" ' Executa ação seguinte ' ActiveWorkbook.Save ' salva arquivo antes de fechar ' Call Elimina_Pasta ' W.Select W.Range("C3").Select ' Do While ActiveCell.Value <> "" ' If ActiveCell.Value = Nome Then ' Sheets("Registro").Select ActiveSheet.Unprotect ' desprotege a planilha ActiveCell.EntireRow.Delete MsgBox "Cadastro excluído com sucesso.", vbOKOnly, "CONTROLE DE ESCRITÓRIO JURÍDICO" Exit Do ' End If ' ActiveCell.Offset(1, 0).Select ' Loop ' ' Call AtualizaCombo Call Ordenar ' Sheets("Registro").Visible = False ' oculta planilha ' Sheets("Cadastro").Select Range("A1").Select ' cmbBusca.Value = "" ' Call LimpaDadosExcluidos ' Application.ScreenUpdating = True ' Else MyString = "Não" ' Nada é executado. Não salva End If ' End Sub

Na Private Sub btExcluir_Click eu coloquei a Call Elimina_Pasta antes de executar a exclusão do cadastro e funcionou legal. Acho que como estava logo acima da Call LimpaDadosExcluidos na sub btExcluir, esta executava mais rápido que a 1ª, pois limpava os campos de data e nome e dava o erro. Obrigado pela ajuda.

consegui resolver, obrigado

Desculpe, mas não funcionou. Continua somente excluindo o cadastro, aparece a mensagem de "pasta não existe" e não deleta no windows explorer

Segue o arquivo. Alterei a extensão dele para poder enviar pois a extensão xlsm não é permitida. Controle Escritorio Juridico.xlsm.xls

Não funcionou. Não excluiu a pasta.

D:\ é uma partição do meu HD onde armazeno os arquivos. Se colocar de novo o RESUME NEXT ele exclui a pasta mas primeiro informa que a pasta não existe e depois volta para deletar. Acredito que a posição da linha "On Error GoTo NaoExistePasta" está errada. Já tentei várias posições mas nenhuma funcionou.

Obrigado pela ajuda mas não funcionou. Excluiu somente o cadastro e a pasta no windows explorer permaneceu. A mensagem de que "a pasta não existe" ficou.

Criei uma macro para excluir a pasta do cliente no windows explorer após a exclusão do cadastro, porém executa primeiro a mensagem "Pasta Cliente FULANO 1_6_2020 não existe ou já foi excluída." e depois executa a exclusão da pasta. Peço ajuda para verificar onde está o erro de sequencia das linhas de comando. Esta mensagem somente deveria aparecer se a pasta não existisse. Tem uma Sub que exclui o cadastro e depois chama esta macro. Segue abaixo a macro criada: Sub Elimina_Pasta() ' ' exclui a pasta do cliente macro ' Dim fso ' X = Range("I10").Value ' X recebe nome contido na célula "I10" Y = Range("E8").Value ' Y recebe o ano contido na célula "E8" Z = Range("F8").Value ' Z recebe o mês contido na célula "F8" W = Range("G8").Value ' Y recebe o dia contido na célula "G8" ' On Error GoTo NaoExistePasta ' Set fso = CreateObject("Scripting.FileSystemObject") ' fso.DeleteFile ("D:\Controle Escritorio\" & X & " " & W & "_" & Z & "_" & Y \ "*.*") fso.DeleteFolder ("D:\Controle Escritorio\" & X & " " & W & "_" & Z & "_" & Y) ' MsgBox "PASTA CLIENTE excluída com sucesso.", vbOKOnly, "CONTROLE DE ESCRITÓRIO" ' Set fso = Nothing ' Exit Sub ' NaoExistePasta: ' MsgBox "Pasta Cliente " & X & " " & W & "_" & Z & "_" & Y & " não existe ou já foi excluída.", vbOKOnly, "CONTROLE DE ESCRITÓRIO" ' Resume Next ' End Sub Agradeço desde já pela ajuda.

proc i5 8gb ram windows 10 x64. HD de 1TB, hd de 2TB e HD de 3TB. Transfiro muitos arquivos entre os HD's e as partições. Sempre acontece a mesma coisa. Acusa espaço insuficiente então reinicio e o espaço livre volta.

tenho um hd de 3TB e quando começo a transferir arquivos o espaço disponível some e só aparece após reiniciar o PC. Ex: espaço livre de 2TB e começo a transferir 1TB. Quando transfere aproximadamente 500GB diz que não tem espaço suficiente. Se reiniciar o PC o espaço livre aparece novamente.

tenho a tabela abaixo. Como interpolar? 5 1 10 2 40 3 70 4 100 5 o valor é 45 e o resultado deve ser 3,17. Não consigo chegar a este valor usando a formula