RafaVillani

@Neodenn Olá, creio que o código possa ser um pouco mais simples do que a forma como você esta tentando, veja se lhe atende dessa forma.

 

Dim Texto As String, A() As String, B() As String
Texto = Sheet1.Cells(4, 4)
A() = Split(Texto, " ")
B() = Split(A(1), "-")

Sheet1.Cells(5, 4) = "*" & A(0) & " *Base " & B(0) & "mm " & "+*? Prat. " & B(1)

 

Segue um modelo que criei.

 

Se a resposta foi útil clique em curtir, se solucionou sua dúvida marque esta resposta como solução.

 

Abraços

 

RafaVillani

Forum Modelo Neodenn.rar

@Tatyh Olá, tente desproteger a planilha no início de seu código (antes de Sheets(“Dados”).Select e proteger ao final (antes de Sheets(“Dados”).Visible = False)

 

Sheets(“Dados”).Unprotect “senha”

 

Sheets(“Dados”).Protect “senha”

 

RafaVillani

@GabrielmanutencaoSeja bem vindo ao fórum. Vejo se esse exemplo lhe atende.

 

Se essa resposta fui útil clique em curtir, se solucionou sua dúvida marque esta resposta como solução.

 

RafaVillani

Exemplo Botão.rar

Ops!!! Falha minha, segue a planilha. @paulotuca

 

 

BOTÃO PINTURA.rar

@paulotucaVeja se é desta forma que você deseja.

 

RafaVillani

LEITURA - teste.rar

@paulotucaMe desculpe por não responder, voltei a trabalhar e meus dias são bastante corridos, principalmente nos finais de semana. Porém, não tenha dúvidas, assim que tiver um tempo tentarei atender.

 

RafaVillani 

@paulocezarpicosMe desculpe

por não lhe responder, voltei a trabalhar e meus dias são bastante corridos, principalmente finais de semana. Contudo, que bom que você conseguiu resolver, no mais, se precisar, é só chamar.

 

RafaVillani 

@MrPaul e @karluxo  vou deixar aqui duas soluções.

 

A primeira você deverá seguir todo o conteúdo deste site: https://excelevba.com.br/imagens-dentro-da-propria-planilha/

Prós: não é necessário salvar a imagem para carrega-la no objeto de imagem.

Contras: geralmente podem ocorrer conflitos no código, dependendo do seu tipo de sistema 32 ou 64 bits, código muito extenso.

 

A segunda seria este código: 

Dim Plan As String
Dim PastaNome As String
Dim oImage As Shape
Dim oSheet As Worksheet
Dim oTemp As ChartObject
Dim oChartArea As Chart

Plan = Plan1.Name
PastaNome = ThisWorkbook.Path & Application.PathSeparator & "imagem.gif" 'nome que será salvo a imagem

Set oSheet = Plan1
Set oImage = oSheet.Shapes.Item("Imagem") 'insira o nome da sua imagem

oImage.CopyPicture

Set oTemp = oSheet.ChartObjects.Add(100, 100, oImage.Width, oImage.Height)
Set oChartArea = oTemp.Chart
oTemp.Activate
With oChartArea
    .ChartArea.Select
    .Paste
    .Export Filename:=PastaNome, filtername:="GIF"
End With
UserForm1.Image1.Picture = LoadPicture(PastaNome)
oTemp.Delete

Este código copia e salva a sua imagem na pasta onde se encontra a pasta de trabalho, para depois carrega-la no objeto image.

Prós: código simples e bem curto, não sobrecarrega.

Contras: Não vejo contras neste código, pessoalmente prefiro ele.

 

RafaVillani

@Jefferson TSTestei aqui, o & .Body funciona corretamenta (veja o video),  você inseriu a assinatura no corpo da mensagem pelo outlook?

 

RafaVillani

Assinatura.rar

@Jefferson TSDesconsidere o post acima, realmente, quando a assinatura contem imagem ela some, tentarei resolver aqui.

 

RafaVillani

@Jefferson TS, tente desta forma:

 

Dim outl As Outlook.Application
Dim novo_email As Outlook.MailItem

Set outl = New Outlook.Application
Set novo_email = outl.CreateItem(olMailItem)

With novo_email
.Display
.To = UserFormEmail.TextBoxEndEmail.Value
.CC = "[email protected]"
.Attachments.Add pdf
.Subject = "Ficha de treino PHYSICAL"
.HTMLBody = "<BR><FONT COLOR=""002288"" SIZE=""4"" BOLD=TRUE>Olá aluno(a), segue em abaixo sua ficha de treino. Bons treinos!</FONT><BR>" & .HTMLBody

'.Send
End With

MsgBox "Email enviado com sucesso", vbInformation, "Email e PDF"

Set outl = Nothing
Set novo_email = Nothing

RafaVillani

@Jefferson TSPrimeiramente configure a assinatura para que apareça nas mensagens do outlook, se você ja tiver feito isso, apenas acrescente este código no final da linha .Body = "Olá aluno(a), segue em abaixo sua ficha de treino. Bons treinos!"

 

& .body

 

RafaVillani

@Gesiane DinizPara melhor lhe ajudar, poderia disponibilizar a planilha para download?

 

RafaVillani

@Jefferson TSO filtro por CPF funcionou?

@paulocezarpicosQue nada, ainda estou aprendendo, se precisar é só chamar.

 

Ps. Você marcou sua própria resposta como solução.

@Jefferson TSConfira se não tem uma mais atual na lista. Qual seu office?

 

RafaVillani

@Jefferson TSVocê habilitou a biblioteca Microsoft Outlook 12.0 Object Library?

 

Dentro do VBA, menu Ferramentas, Referências, selecione a biblioteca e aperte OK.

 

RafaVillani

@paulocezarpicosQuando você alterou o código você colocou o Exit Sub no lugar errado, o que está acontecendo é que o filtro esta ocorrendo e, após, o código Exit Sub é ativado e o código é interrompido, e as linhas abaixo do End If não são lidas-executadas, na verdade, o código deve ser interrompido quando a variável QtdLinhaFiltro foi maior que 31.

 

Para corrigir basta você mover o Exit Sub e coloca-lo acima do Else, ficando assim:

If QtdLinhaFiltro > 31 Then
    MsgBox "Intervalo entre datas muito grande, selecione outro intervalo!", vbInformation, "FILTRO"
Exit Sub
Else: Plan16.Range("A7:K" & QtdLinhaFiltro + 6) = MatrizFiltro
End If
Call imprimir
Unload UserForm1
Unload Me
End Sub

RafaVillani

@Jefferson TSIrei olhar, aproveitei que você me enviou sua planilha e corrigi onde você estava errando com o filtro do CPF, arrumei e está funcionando, teste e me diga se funcionou ai pra você.

 

RafaVillani

PHYSICAL.rar

@Jefferson TSNa verdade o que ocorre é, apesar da linha estar com cor diferente ela não existe, então no primeiro clique é inserida a primeira linha, depurei o código para confirmar isso, e é exatamente isso que ocorre, tanto que se você tentar deletar essa linha o msgbox será mostrado.

 

Faça o teste, exclua todas as linhas até a mensagem ser mostrada, depois insira uma linha, e tente deletar, mesmo não mostrando na tabela a linha foi inserida e será deletada.

 

RafaVillani

@Jefferson TSSubstitua seu código por esse.

Sub InsereLinha()
Call Desprotege

Dim Tabela As ListObject
Set Tabela = Planilha9.ListObjects("Tabela11")
Tabela.ListRows.Add
    
Call Protege

RafaVillani

@Jefferson TSaltere no seu código:

 

If UltimaLinha = 1 Then

 

por

 

If UltimaLinha = 0 Then

 

e  apague essas 3 linhas

 

Range("Tabela11[[#Headers],[EXERCÍCIO]]").Select

Selection.End(xlDown).Select

Selection.EntireRow.Delete

 

e abaixo da linha Sheets("ficha_treino").Activate coloque esta

 

Tabela.ListRows(UltimaLinha).Delete

RafaVillani

@Jefferson TSVocê quer deletar a primeira linha abaixo do cabeçalho?

 

Ps: O filtro pelo CPF funcionou?

 

RafaVillani

@Jefferson TSRevisado e testado, funcionando perfeitamente, veja o vídeo.

 

RafaVillani

Filtro CPF.rar

@Jefferson TSVeja se dessa forma lhe atende.

 

RafaVillani

CONTROLE NOVO.rar

@Jefferson TSSegue novamente a planilha, havia um erro que eu corrigi.

CONTROLE NOVO.rar

@Jefferson TSSegue sua planilha, fiz o filtro dos Ativos e Inativos, e acrescentei um novo botão de opção para mostrar todos.

 

Quanto a forma de alterar o Status, fiz com apenas um botão, se o status for Ativo ele é altera para Inativo, se for Inativo é alterado para Ativo.

 

Quanto a opção do filtro por CPF ou Nome, acredito que o @AfonsoMirajá o instruiu no outro tópico.

 

RafaVillani

CONTROLE NOVO.rar

@Jefferson TSQual a senha da planilha?