Leo P Costa
Membro Pleno-
Posts
25 -
Cadastrado em
-
Última visita
Reputação
0-
Formatação celula quando atinge um determinado valor.
Leo P Costa respondeu ao tópico de Leo P Costa em Microsoft Office e similares
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 -
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
-
Erro em tempo de execução '424': O Objeto é obrigatório
Leo P Costa respondeu ao tópico de Leo P Costa em Microsoft Office e similares
Boa tarde. Consegui resolver o meu problema, era apenas o nome de uma das TextBox que estava errado. Obrigado -
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
-
Worksheet_SelectionChange
Leo P Costa respondeu ao tópico de Leo P Costa em Microsoft Office e similares
Funcionou perfeitamente. Obrigado -
Worksheet_SelectionChange
Leo P Costa respondeu ao tópico de Leo P Costa em Microsoft Office e similares
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. -
Worksheet_SelectionChange
Leo P Costa respondeu ao tópico de Leo P Costa em Microsoft Office e similares
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. -
Worksheet_SelectionChange
Leo P Costa respondeu ao tópico de Leo P Costa em Microsoft Office e similares
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. -
Worksheet_SelectionChange
Leo P Costa respondeu ao tópico de Leo P Costa em Microsoft Office e similares
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. -
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.
-
Dividir Caminho absoluto de nome do arquivo
Leo P Costa postou um tópico em Microsoft Office e similares
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. -
Copiar aquivo com data diferentes
Leo P Costa respondeu ao tópico de Leo P Costa em Microsoft Office e similares
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. -
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.
-
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.
-
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