Ir ao conteúdo
  • Cadastre-se

Leo P Costa

Membro Pleno
  • Posts

    25
  • Cadastrado em

  • Última visita

  1. consegui criar uma formula, segue ela: sub somar() range("e3").activate for each celula in range("e3:teste") soma = soma + celula.value 'pega e soma o valor da celula if soma >= 600 then activecell.interior.colorindex = 3 'aqui deixa o fundo da celular selecionada vermelha soma = soma - 600 'aqui tira a diferença else activecell.interior.colorindex = 0 'aqui deixa o fundo da celular selecionada branca end if activecell.offset(1, 0).activate 'passa pra proxima celula next end sub
  2. Boa tarde. Gostaria de saber se tem alguma forma de formatar ou criar alguma formula quando em uma planilha atinge determinado valor. Vou explicar melhor: Tenho uma planilha onde lanço os pedidos de um cliente, na coluna do valor eu tenho a soma total no final, mas gostaria de saber se durante os lançamentos dos valores, tem como eu formatar para que uma das celulas com o valor lançado ficasse em vermelho quando atingisse um determinado valor, tipo 600,00. Exemplo: Os valores são lançados na coluna E E3 = 100,00 E4: = 100,00 E5: = 200,00 E6: = 200,00 (esse valor ficasse em vermelho) E7: = 300,00 E8: = 200,00 E9: = 100,00 (Esse valor ficasse em vermelho) E10: = 50,00 E11: = 100,00 E12: = 35,00 E13: = 40,00 E14: = 50,00 E15: = 100,00 E16: = 50,00 E17: = 35,00 E18: = 35,00 E19: = 75,00 E20: = 65,00 (Esse valor ficasse em vermelho) E21: = (soma total) ou seja, a cada 600,00 a ultima que daria ou completasse a soma de 600,00 ficasse em vermelho, pois nem sempre a soma será de 600,00 redondo, pode ser que passe um pouco. Anexei a tabela que uso para os clientes. Fico no aguardo. Obrigado. RELAÇÃO CLIENTE - Cópia.rar
  3. Boa tarde. Consegui resolver o meu problema, era apenas o nome de uma das TextBox que estava errado. Obrigado
  4. Boa noite. Estou com um codigo de um formulario, sempre que vou rodar ele gera um erro de tempo de execução 424, segue codigo. Mas ele não mostra onde está o erro. Private Linha As IntegerPublic GravarAlterar As IntegerPrivate Sub Atualiza_Form() Cells(Linha, 1).Activate Txt_Cartao.Value = Cells(Linha, 1) Txt_Data.Value = Cells(Linha, 2) Txt_Descricao.Value = Cells(Linha, 3) Txt_Valor.Value = Cells(Linha, 4) Txt_Pgnt.Value = Cells(Linha, 5) Txt_Quantidade.Value = Cells(Linha, 6)End SubPrivate Sub Cmd_Alterar_Click()If Txt_Cartao.Value = "" ThenMsgBox "Selecione o registro", vbCritical, "Erro"ElseGravarAlterar = 2Frame1.Enabled = TrueCmd_Anterior.Enabled = FalseCmd_Proximo.Enabled = FalseCmd_Incluir.Enabled = FalseCmd_Alterar.Enabled = FalseCmd_Gravar.Enabled = TrueCmd_Cancelar.Enabled = TrueCmd_Excluir.Enabled = FalseEnd IfEnd SubPrivate Sub Cmd_Anterior_Click()Linha = ActiveCell.RowIf Linha < 6 ThenLinha = Linha - 1Atualiza_FormElseAtualiza_FormMsgBox "Primeiro Registro", vbInformation, "Planilha de Despesas"End IfEnd SubPrivate Sub Cmd_Cancelar_Click()Call UserForm_InitializeEnd SubPrivate Sub Cmd_Excluir_Click()Dim del As StringIf ActiveCell.Value = "" ThenMsgBox "Selecione um registro para exclusão", vbCritical, "Erro de Operação"ElseIf ActiveCell.Value <> "" Thendel = (MsgBox("Deseja excluir o registro ativo?" & Me.Txt_Cartao & " " & _Me.Txt_Descricao, vbYesNo + vbQuestion, "Exclusão de Dados"))If del = vbYes ThenActiveCell.EntireRow.DeleteLinha = Linha - 1Call UserForm_InitializeElseMsgBox "Operação cancelada", vbInformation, "Planilha de Despesas"Call UserForm_InitializeEnd IfEnd IfEnd SubPrivate Sub Cmd_Gravar_Click()Select Case GravarAlterarCase Is = 1 If Txt_Cartao.Value = "" Then MsgBox "Obrigatório preencher campo Cartão", vbCritical, "Erro" ElseIf Txt_Data.Value = "" Then MsgBox "Obrigatório preencher campo Data", vbCritical, "Erro" ElseIf Txt_Descricao.Value = "" Then MsgBox "Obrigatório preencher campo Descrição", vbCritical, "Erro" ElseIf Txt_Valor.Value = "" Then MsgBox "Obrigatório preencher campo Valor", vbCritical, "Erro" ElseIf Txt_Quantidade.Value = "" Then MsgBox "Obrigatório preencher campo Quantidade", vbCritical, "Erro" ElseIf Cbo_Mes.Value = "" Then MsgBox "Obrigatório preencher campo Mês", vbCritical, "Erro" Else While ActiveCell.Value <> "" ActiveCell.Offset(1, 0).Select Wend Linha = ActiveCell.Row Cells(Linha, 1) = Txt_Cartao.Value Cells(Linha, 2) = Txt_Data.Value Cells(Linha, 3) = Txt_Descricao.Value Cells(Linha, 4) = Txt_Valor.Value Cells(Linha, 6) = Txt_Quantidade.Value UserForm_Initialize End If Case Is = 2 Cells(Linha, 1) = Txt_Cartao.Value Cells(Linha, 2) = Txt_Data.Value Cells(Linha, 3) = Txt_Descricao.Value Cells(Linha, 4) = Txt_Valor.Value Cells(Linha, 5) = Txt_Pgnt.Value Cells(Linha, 6) = Txt_Quantidade.Value UserForm_Initialize MsgBox "Dados alterados com sucesso", vbInformation, "Planilha de Despesas" End SelectEnd SubPrivate Sub Cmd_Incluir_Click()GravarAlterar = 1Me.Txt_Cartao.Value = ""Me.Txt_Data.Value = ""Me.Txt_Descricao.Value = ""Me.Txt_Valor.Value = ""Me.Txt_Pgnt.Value = ""Me.Txt_Quantidade.Value = ""Me.Cbo_Mes.Value = ""Frame1.Enabled = TrueFrame2.Enabled = TrueMe.Txt_Cartao.SetFocusCmd_Anterior.Enabled = FalseCmd_Proximo.Enabled = FalseCmd_Incluir.Enabled = FalseCmd_Alterar.Enabled = FalseCmd_Gravar.Enabled = TrueCmd_Cancelar.Enabled = TrueCmd_Excluir.Enabled = FalseEnd SubPrivate Sub Cmd_Proximo_Click()Linha = ActiveCell.RowIf Cells(Linha + 1, 1).Value <> "" ThenLinha = Linha + 1Atualiza_FormElseAtualiza_FormMsgBox "Último Registro", vbInformation, "Planilha de Despesas"End IfEnd SubPrivate Sub Cmd_Sair_Click()Dim sairsair = (MsgBox("Deseja fechar o cadastro de despesas de Janeiro?", vbYesNo + vbQuestion, "Planilha de Despesas"))If sair = vbYes ThenActiveWorkbook.SaveUnload MeFrm_Menu.ShowEnd IfEnd SubPrivate Sub UserForm_Initialize()Sheets("JANEIRO").SelectRange("A6").SelectTxt_Cartao.Value = ""Txt_Data.Value = ""Txt_Descricao.Value = ""Txt_Valor.Value = ""Txt_Pgnt.Value = ""Txt_Quantidade.Value = ""Frame1.Enabled = FalseFrame2.Enabled = TrueCmd_Anterior.Enabled = TrueCmd_Proximo.Enabled = TrueCmd_Incluir.Enabled = TrueCmd_Alterar.Enabled = TrueCmd_Gravar.Enabled = FalseCmd_Cancelar.Enabled = FalseCmd_Excluir.Enabled = TrueCbo_Mes.ClearWith Me.Cbo_Mes .AddItem "Janeiro" .AddItem "Fevereiro" .AddItem "Março" .AddItem "Abril" .AddItem "Maio" .AddItem "Junho" .AddItem "Julho" .AddItem "Agosto" .AddItem "Setembro" .AddItem "Outubro" .AddItem "Novembro" .AddItem "Dezembro"End WithWorksheets("JANEIRO").SelectRange("A6").SelectWhile ActiveCell.Value <> ""ActiveCell.Offset(1, 0).SelectWendDados = ActiveCell.RowLst_DespesaJaneiro.RowSource = Range(Cells(6, 1), Cells(Dados, 6)).AddressEnd SubPrivate Sub Cbo_Mes_Change() If Cbo_Mes = "Fevereiro" Then Unload Me Frm_Fevereiro.Show End If End SubPrivate Sub Txt_Data_Change()If Txt_Data.TextLength = 2 Or Txt_Data.TextLength = 5 Then Txt_Data.Text = Txt_Data.Text + "/"End If End SubPrivate Sub Txt_Parcela_Change()If Txt_Parcela.TextLength = 2 Then Txt_Parcela.Text = Txt_Parcela.Text + "/"End IfEnd SubPrivate Sub Txt_Pgnt_Exit(ByVal Cancel As MSForms.ReturnBoolean) Txt_Pgnt = Format(Txt_Pgnt, "R$ #,##0.00") End SubPrivate Sub Txt_Valor_Exit(ByVal Cancel As MSForms.ReturnBoolean) Txt_Valor = Format(Txt_Valor, "R$ #,##0.00") End Sub
  5. Já fiz esse teste, até que funciona para que o código seja inserido, mas ai o problema no botão de inserir linha volta, quando clico no botão aparece 4x para inserir o código. A mesclagem foi necessário para a minha tabela, uma vez que quando coloca o código aparece o nome do produto, e ele geralmente e maior do que a célula.
  6. Estou disponibilizando o relatório. Relatorio Diario Muriaé - 2015.rar Dentro do quadrado em negrito tem que aparecer uma inputbox para que seja inserido um código e não está aparecendo.
  7. Tive que reabrir esse post, hoje abri o relatório e quando clico para inserir o código no meio do relatório, não aparece a inputbox para inserir o código.
  8. Sub InserirLinhaRelatorio()' Inserindo linha no campo do Relatório Application.ScreenUpdating = False Sheets("Relatório").Unprotect ("2550") Range("Vendas").Activate ActiveCell.Offset(-1, 0).Select Selection.EntireRow.Insert Intersect(Selection.EntireRow, Range("D:F")).Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Merge Intersect(Selection.EntireRow, Range("G:I")).Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Merge Intersect(Selection.EntireRow, Range("J:L")).Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Merge Intersect(Selection.EntireRow, Range("M:N")).Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Merge ActiveCell.Offset(0, -12).Select ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _ True, AllowFormattingCells:=True, AllowFormattingColumns:=True, _ AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:= _ True, AllowSorting:=True, AllowFiltering:=True, Password:=("2550")End Sub Esse é o código de inserir linha que uso no botão. Sobre os tópicos um eu já cliquei em resolvido o outro ainda não tive tempo para poder dar uma olhada, por isso ainda não respondi.
  9. Boa tarde, possuo um código que ao clicar em uma célula (Mesclada) aparece uma inputbox, veja abaixo o código: Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.ScreenUpdating = FalseDim Selection, Resposta As IntegerDim cod As StringDim txtValor As CurrencyIf Not Intersect(Target, Range("Codigo1:Codigo2")) Is Nothing Then Selection = Application.InputBox("Digite o código", "Código", "Número do código", Type:=1)End IfEnd Sub "Codigo1:Codigo2", são intervalos renomeados, que seria o mesmo de "D4:D21" e "N4:N21". Dentro desse parâmetro que ao clicar aparece a inputbox. Ela funciona perfeitamente, o que meu problema é que tenho um botão que insere linha, e esse botão pega um intervalo dentro do parâmetro e aparece as inputbox, mas eu gostaria que fosse bloqueado essas inputbox quando eu clicasse nesse botão. O botão de inserir linha, sempre vai selecionar a linha acima da "Venda:".Segue desenho para melhor entendimento: Desde já agradeço.
  10. Boa tarde. Possuo um código que me retorna o caminho absoluto + nome do arquivo, segue código: Sub lsSelecionarArquivo() Dim fDlg As FileDialog Dim lArquivo As String 'Chama o objeto passando os parâmetros Set fDlg = Application.FileDialog(FileDialogType:=msoFileDialogOpen) With fDlg 'Alterar esta propriedade para True permitirá a seleção de vários arquivos .AllowMultiSelect = False 'Determina a forma de visualização dos aruqivos .InitialView = msoFileDialogViewDetails 'Filtro de arquivos, pode ser colocado mais do que um filtro separando com ; por exemplo: "*.xls;*.xlsm" .Filters.Add "Texto", "*.xlsm", 1 'Determina qual o drive inicial .InitialFileName = "C:\" 'Texto da barra .Title = "Selecionar arquivo" End With 'Retorna o arquivo selecionado If fDlg.Show = -1 Then lArquivo = fDlg.SelectedItems(1)end sub Neste caso, o lArquivo quando seleciono um arquivo por exemplo, me retorna isso: F:\ARQUIVOS LOJA\RELATORIOS LOJAS\MURIAÉ\2015\ABRIL\Relatorio Diario Muriaé - 01-04-2015.xlsm Eu preciso de uma forma de separar o caminho do nome do arquivo F:\ARQUIVOS LOJA\RELATORIOS LOJAS\MURIAÉ\2015\ABRIL\ Relatorio Diario Muriaé - 01-04-2015.xlsm para trabalhar com eles separados, teria alguma forma disso acontecer? Lembrando, o nome do caminho e do arquivo podem variar. Desde já agradeço.
  11. Desculpa pela demora da resposta. Muito obrigado pela sua ajuda, atendeu perfeitamente o que precisava, em questão do mês e o ano que você deu a dica, eu já havia pensado e arrumado o meu código.
  12. Boa noite. Possuo um código que copia uma pasta de trabalho, ela funciona normalmente, porém gostaria de criar com as datas do mês tirando o final de semana. Segue meu código que cria com a data 01 até 31. Sub CopyFolders()Dim dia As Byte For dia = 1 To 31FileCopy "F:\Relatorio Diario Barbacena - 2015.xlsm", "F:\ARQUIVOS LOJA\RELATORIOS LOJAS\BARBACENA\2015\JUNHO\Relatorio Diario Barbacena - " & (Format(dia, "0#")) & "-06-2015.xlsm" Next diaEnd Sub Neste código ele cria os arquivos Relatorio Diario Barbacena - 01-06-2015 até 31-06-2015, mas preciso eliminar as datas que seriam os finais de semana refente aquele mês.
  13. Deu certo. Obrigado. Segue anexo com a planilha em questão. Relatorio Diario - 2015.rar Já consegui resolver aqui. Tive que ativar a célula onde está escrito a palavra "ENTRADA" e usar o Offset, dessa forma funciona perfeitamente o que eu buscava.
  14. Osvaldo, boa tarde. Estou tentando anexar o arquivo, porém o sistema diz que eu não tenho permissão para fazer o upload deste tipo de arquivo, que seria uma planilha do excel.

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...