Jefferson TS

@AfonsoMira Private Sub CommandButton1_Click() If ComboBox1.Value = "" Then MsgBox "Selecione o colaborador", vbInformation, "Ítem obrigatório" Exit Sub End If If TextBox8.Value = "" Then MsgBox "Selecione a data", vbInformation, "Ítem obrigatório" Exit Sub End If Dim PLAN As String PLAN = UserForm1.ComboBox1.Text dia = UserForm1.TextBox8.Text Worksheets(PLAN).Activate linha = Cells.Find(dia).Row ActiveSheet.Cells(linha, 7) = UserForm1.TextBox1.Text ActiveSheet.Cells(linha, 8) = UserForm1.TextBox2.Text ActiveSheet.Cells(linha, 9) = UserForm1.TextBox3.Text ActiveSheet.Cells(linha, 10) = UserForm1.TextBox4.Text ActiveSheet.Cells(linha, 11) = UserForm1.TextBox5.Text ActiveSheet.Cells(linha, 12) = UserForm1.TextBox6.Text If CheckBox1.Value = True Then ActiveSheet.Cells(linha, 6) = "X" End If If CheckBox2.Value = True Then ActiveSheet.Cells(linha, 5) = "X" End If UserForm1.TextBox1.Value = Empty UserForm1.TextBox2.Value = Empty UserForm1.TextBox3.Value = Empty UserForm1.TextBox4.Value = Empty UserForm1.TextBox5.Value = Empty UserForm1.TextBox6.Value = Empty UserForm1.CheckBox1.Value = False UserForm1.CheckBox2.Value = False MsgBox ("Dados salvos na planilha com sucesso"), vbInformation, "Sucesso" End Sub Dá erro na parte: linha = Cells.Find(dia).Row

@AfonsoMira Em anexoPONTO - Copia.rar As celulas da coluna B são a referência para a linha que deve receber os dados do form. Essa referência fica indicada no texbox da Data ao lado do combobox do Colaborador, e são alteradas com o spinbutton (que aliás não sei como fazer funionar também hehe)

Olá. Preciso localizar em uma coluna da planilha a data de um textbox, e então contar as linhas, para servir de referência para 'linha' na hora de lançar os dados do formulário para a planilha. Alguém sabe me dizer como posso escrever isso?

@Muca Costa Seria em um textbox de um formulário

@Muca Costa O resultado final (quando sai da celula está certo), quero fazer a formatação em tempo real, enquanto digita, ou seja, já começa com ,00 e quando digito vírgula posso colocar os centavos.

@Midori Deu certo. Muito obrigado.

Olá, ao salvar, preciso que a tabela utilizada volte a ter 12 linhas (mesmo que tenham sido adicionadas ou excluídas algumas linhas) Segue abaixo o código que estou tentando utilizar e que não está funcionando: Sub linhas() Dim tabela As ListObject Dim UltimaLinha As Long Set tabela = Plan5.ListObjects("Tabela1") UltimaLinha = tabela.ListRows.Count If UltimaLinha < 12 Then Do Until UltimaLinha = 12 Call InsereLinha x = x - 1 Loop End If If UltimaLinha > 12 Then Do Until UltimaLinha = 12 Call ExcluiLinha x = x - 1 Loop End If End Sub

@Muca Costa Neste caso os primeiros dois caracteres digitados são considerados valor decimal, no entanto preciso que tudo o que eu digitar seja valor inteiro, e somente passe para decimal após eu digitar a vírgula. Ou seja enquanto eu não digitar a vírgula, as casas decimais continuam ",00"

Olá. Alguém sabe me dizer como faço para deixar duas casas decimais e separador de milhar no textbox automaticamente enquanto digita? Por exemplo, se eu digitar 1000 quero que apareça 1.000,00 e se eu quiser centavos digito a vírgula para inserir os centavos.

@RafaVillani Show. Deu certo. Muito obrigado novamente. Aquela parte do cpf ainda não testei, vou testar hj a noite.

@RafaVillani Tentei desta e de outras formas mas não deu certo. Minha assinatura do outlook é uma imagem, enquanto o código está em execução dá pra ver que quando inicia a montagem do email (inserir destinatário, cco, título, anexo, etc) aparece essa assinatura, porém, no momento em que o corpo (.body) é inserido, desaparece a assinatura. Anexei a planilha. PHYSICAL.rar

Olá. Tenho uma assinatura configurada no outlook com nome physical. Alguém saberia me dizer como seleciono essa assinatura no vba para enviar automaticamente. E outra coisa, meu código não está enviando o email, ele fica na caixa de saída do outlook, estou tendo que abrir o outlook e clicar em enviar toda vez. Segue abaixo o código que estou utilizando: Dim outl As Object, novo_email As Object Set outl = CreateObject("outlook.application") Set novo_email = outl.CreateItem(0) With novo_email .Display .To = UserFormEmail.TextBoxEndEmail.Value .CC = "[email protected]" .Attachments.Add pdf .Subject = "Ficha de treino PHYSICAL" .Body = "Olá aluno(a), segue em abaixo sua ficha de treino. Bons treinos!" .Send End With

@RafaVillani vou ver isso hj de noite e te aviso

@RafaVillani Deu certo, Marquei outros 3 itens que tinham outlook no nome e deu certo. Obrigado.

@RafaVillani Office 2019 Tá reiniciando. Já vejo e te falo

@RafaVillani Habilitei. Mas não era 12.0. Acho que era 6.0

@RafaVillani A tá. Entendi. Muito obrigado. Acabei de postar um novo tópico sobre enviar email com o excel, poderia dar uma olhada lá? Acredito que seria a última coisa pra mim finalizar esta planilha aqui, graças a Deus.

Olá. Tenho esta macro abaixo para enviar email com o outlook anexando um pdf. Está dando erro nessa linha: Set outl = CreateObject("outlook.application") Alguém poderia me ajudar a solucionar isto? segue o código e a planilha em anexo: Sub enviar_EMAIL() Call Desprotege If Worksheets("ficha_treino").Range("a14").Value = "" Then MsgBox "Pelo menos a primeira linha da tabela deve ser preenchida", vbInformation, "Erro" Exit Sub End If 'SalvarPDF Macro Sheets("ficha_treino").Select ID = Worksheets("ficha_treino").Range("a9") NOME = Worksheets("ficha_treino").Range("d7") pdf = ThisWorkbook.Path & "\" & NOME & " - Ficha " & ID & ".pdf" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _ Filename:=pdf 'atualizar numeração Sheets("FICHA_TREINO").Select Range("A9").Select Selection.Copy Sheets("STAFF").Select Range("A60000").End(xlUp).Offset(1, 0).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("FICHA_TREINO").Select Application.CutCopyMode = False MsgBox "Treino de " & NOME & "" & Chr(13) & "PDF salvo e email enviado", vbInformation, "Email e PDF" ' limpartudo Macro Range("D7:E7").Select Selection.ClearContents Range("D8:E8").Select Selection.ClearContents Range("B10:E10").Select Selection.ClearContents Range("B11:E11").Select Selection.ClearContents Planilha9.ListObjects("Tabela11").DataBodyRange.Delete Range("D7:E7").Select Dim outl As Object, novo_email As Object Set outl = CreateObject("outlook.application") Set novo_email = outl.CreateItem(0) With novo_email .Display .To = UserFormEmail.TextBoxEndEmail.Value .CC = "[email protected]" .Attachments.Add pdf .Subject = "Ficha de treino PHYSICAL" .Body = "Olá aluno(a), segue em abaixo sua ficha de treino. Bons treinos!" .Send End With Call Protege ActiveWorkbook.Save End Sub PHYSICAL.rar

@RafaVillani Show. Muito obrigado. Esta me ajudando muito com isso aqui. Só um detalhe, como a tabela sempre vai ter uma linha além da linha de cabeçalhos, o primeiro clique no botão inserir linha não faz nada, tem como identificar que já existe uma linha e então inseir a segunda linha já no primeiro clique?

@RafaVillani Perfeito. E enquanto a parte de inserir linha, no caso quando eu clico em excluir linha até o ponto de aparecer a msgbox "A tabela deve conter pelo menos uma linha além dos cabeçalhos." Então quando eu clico em inserir linha, vai lá pra ultima linha da tabela "1048576", ou seja, está funcionando, mas primeiro ela faz isto, o que é muito chato. Sabe me dizer como faria pra não descer até a última linha? Sub InsereLinha() Call Desprotege Sheets("ficha_treino").Select Range("A13").Select Selection.End(xlDown).Select Selection.ListObject.ListRows.Add Selection.End(xlDown).Select Call Protege End Sub

@RafaVillani Quero apagar a última linha da tabela. Vou testar esta parte mais tarde. Te falo se deu certo.

Olá. Tenho esta macro para excluir linha de uma tabela e manter a planilha sempre bloqueada, porém está apagando os dados já digitados das linhas anteriores. Alguém poderia me ajudar a consertar isso? PHYSICAL.rar Sub ExcluiLinha() Dim Tabela As ListObject Dim UltimaLinha As Long Set Tabela = Planilha9.ListObjects("Tabela11") UltimaLinha = Tabela.ListRows.Count If UltimaLinha = 1 Then MsgBox "A tabela deve conter pelo menos uma linha além dos cabeçalhos.", vbInformation, "ERRO!" Exit Sub Else: Call Desprotege Sheets("ficha_treino").Activate Range("Tabela11[[#Headers],[EXERCÍCIO]]").Select Selection.End(xlDown).Select Selection.EntireRow.Delete Call Protege End If End Sub

@RafaVillani Não deu certo a parte do cpf, está trazendo na listbox sempre o primeiro cadastro da tabela, mas não sei como fazer pra consertar isso: Sub Filtro_CPF() Dim Cont As Long Dim Linha As Long Dim CPF As String Dim LinhaMatriz As Long Dim C As Object Dim Primeiro As String Dim L As Long Dim fonte(1 To 1000, 1 To 10) As Variant If Me.TextBoxPESQUISAR.Value = Empty Then Me.ListBoxPESQUISAR.RowSource = Planilha2.ListObjects("tabela_cadastro") Exit Sub End If L = Planilha7.Range("a5").CurrentRegion.Rows.Count + 4 Planilha7.Range("A5:J" & L).ClearContents LinhaMatriz = 1 Linha = 5 CPF = Me.TextBoxPESQUISAR Set C = Planilha2.Range("E:E").Find(CPF) Linhalistbox = 0 If Not C Is Nothing Then Primeiro = C.Address Do fonte(LinhaMatriz, 1) = C.Offset(0, -4).Value fonte(LinhaMatriz, 2) = C.Offset(0, -3).Value fonte(LinhaMatriz, 3) = C.Offset(0, -2).Value fonte(LinhaMatriz, 4) = C.Offset(0, -1).Value fonte(LinhaMatriz, 5) = C.Offset.Value fonte(LinhaMatriz, 6) = C.Offset(0, 1).Value fonte(LinhaMatriz, 7) = C.Offset(0, 2).Value fonte(LinhaMatriz, 8) = C.Offset(0, 3).Value fonte(LinhaMatriz, 9) = C.Offset(0, 4).Value fonte(LinhaMatriz, 10) = C.Offset(0, 5).Value LinhaMatriz = LinhaMatriz + 1 Cont = Cont + 1 Set C = Planilha2.Range("E:E").FindNext(C) Loop While Primeiro <> C.Address End If If Cont = 0 Then Me.ListBoxPESQUISAR.RowSource = Planilha7.Range("A5:J5").Address Exit Sub End If Cont = Cont + 4 Planilha7.Range("A5:J" & Cont) = fonte Me.ListBoxPESQUISAR.RowSource = Planilha7.Range("A5:J" & Cont).Address End Sub CONTROLE NOVO.rar

Olá. Alguém poderia me ajudar com este filtro, especificamente na parte do CPF, não aparece nada quando digito: Private Sub TextBoxPESQUISAR_Change() Call Desprotege Application.ScreenUpdating = False If OptionButtonNOME.Value = True Then Planilha7.Range("m2") = TextBoxPESQUISAR.Value Call FiltroPesquisar Application.ScreenUpdating = True End If If OptionButtonCPF.Value = True Then Dim cpf As String cpf = TextBoxPESQUISAR.Value Planilha7.Range("p2") = cpf Call FiltroPesquisar Application.ScreenUpdating = True End If Application.ScreenUpdating = True Call Protege End Sub CONTROLE NOVO.rar

@AfonsoMira Não deu certo, poderia dar uma olhada por gentileza. E se puder me ajudar com a parte do filtro desse formulário também: CONTROLE NOVO.rar