Zamboni_du

@Midori @Midori , Enviar o email com as informações no corpo está funcionando corretamente, o que gostaria que aparecesse a opção de escolher um ou vários arquivo para anexar no email. O código abaixo deveria fazer isso porém não está fazendo .

Set xApp = CreateObject("Excel.Application")
xApp.Visible = False
Set xFileDlg = xApp.Application.FileDialog(msoFileDialogFilePicker)
xFileDlg.InitialFileName = "C:\Users\" & Environ("UserName") & "\"C:\Users\Win10x64Test\Desktop\save attachments\"  'Specify the path to the folder you want to open
xFileDlg.AllowMultiSelect = True
If xFileDlg.Show = 0 Then GoTo L1
Set xMail = Application.ActiveInspector.CurrentItem <- linha onde está apresentando o Erro em tempo de execução '438: Objeto não aceita esta propriedade ou método
For Each xSelItem In xFileDlg.SelectedItems
    xMail.Attachments.Add xSelItem
Next
L1:
    xApp.Quit
    Set xFileDlg = Nothing
    Set xApp = Nothing

@Midori Bom dia!!!!

Realizei a alteração e apresentou o mesmo erro. Esse código não abre uma nova janela do MS Outlook mas no próprio Excel.

@Midori @Midori Boa tarde!!!!

Segue abaixo:

Sub enviar_corpo_email()

Dim BR As Variant, dtToday As String, Anexo As Variant

Dim xApp As Object
Dim xFileDlg As FileDialog
Dim xSelItem As Variant
Dim xMail As MailItem

'Organiza em Ordem numérica campo Referência
Planilha4.ListObjects("Tabela8").Sort.SortFields.Clear
    Planilha4.ListObjects("Tabela8").Sort.SortFields.Add2 _
        Key:=Range("Tabela8[[#All],[Referência]]"), SortOn:=xlSortOnValues, Order _
        :=xlAscending, DataOption:=xlSortTextAsNumbers
    With Planilha4.ListObjects("Tabela8").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'Seleciona o intervalo de células a serem enviadas por email.

Planilha3.Select

   Planilha3.Range("A4:H28").Select
   
   ActiveWorkbook.EnvelopeVisible = True

Set BR = Planilha12.Range("J3")
dtToday = Date
   
   With ActiveSheet.MailEnvelope
      
      'On Error Resume Next
Set xApp = CreateObject("Excel.Application")
xApp.Visible = False
Set xFileDlg = xApp.Application.FileDialog(msoFileDialogFilePicker)
xFileDlg.InitialFileName = "C:\Users\" & Environ("UserName") & "\"C:\Users\Win10x64Test\Desktop\save attachments\"  'Specify the path to the folder you want to open
xFileDlg.AllowMultiSelect = True
If xFileDlg.Show = 0 Then GoTo L1
Set xMail = Application.ActiveInspector.CurrentItem <- linha onde está apresentando o Erro em tempo de execução '438: Objeto não aceita esta propriedade ou método
For Each xSelItem In xFileDlg.SelectedItems
    xMail.Attachments.Add xSelItem
Next
L1:
    xApp.Quit
    Set xFileDlg = Nothing
    Set xApp = Nothing

      .Item.To = Planilha11.Range("C21")

      .Item.Subject = "Rotas " & BR
         
      .Item.Display
      
      '.Item.Send

   End With
   
'Planilha10.Select

End Sub
 

@Midori Boa tarde,

Deu erro nessa linha:

Set xMail = Application.ActiveInspector.CurrentItem

Em 19/04/2024 às 10:35, Zamboni_du disse:

Bom dia!!!!

 

Eu tenho uma aplicação para enviar e-mail direto do Excel, porém eu preciso em alguns casos escolher o anexo. Utilizando o método Attachments.Add eu consigo anexar um arquivo específico porém eu necessito que seja aberta a caixa de diálogo para que eu escolha o arquivo,

O código abaixo a caixa de diálogo para escolher o arquivo porém não anexa.

With ActiveSheet.MailEnvelope
      
      On Error Resume Next
Set xApp = CreateObject("Excel.Application")
xApp.Visible = False
Set xFileDlg = xApp.Application.FileDialog(msoFileDialogFilePicker)
xFileDlg.InitialFileName = "C:\Users\Win10x64Test\Desktop\save attachments\"  'Specify the path to the folder you want to open
xFileDlg.AllowMultiSelect = True
If xFileDlg.Show = 0 Then GoTo L1
Set xMail = Application.ActiveInspector.CurrentItem
For Each xSelItem In xFileDlg.SelectedItems
    xMail.Attachments.Add xSelItem
Next
L1:
    xApp.Quit
    Set xFileDlg = Nothing
    Set xApp = Nothing

Bom dia!!!!

Eu tenho uma aplicação para enviar e-mail direto do Excel, porém eu preciso em alguns casos escolher o anexo. Utilizando o método Attachments.Add eu consigo anexar um arquivo específico porém eu necessito que seja aberta a caixa de diálogo para que eu escolha o arquivo,

Boa noite,

Gostaria de saber se existe a possibilidade de criar um forms de forma automática utilizando informações de uma planilha.

Tenho uma planilha com algumas informações onde crio um forms para ser respondido, porém essas informações mudam diariamente e gostaria de automatizar esse processo.

Boa tarde pessoal tudo bem?

Eu preciso encontrar o maior valor em uma coluna porém eu tentei a formula abaixo e me trouxe o valor "0" ao invés de 000062125-1

PriLin = Application.Max(Range("F10:F45"))

Coluna F contem os valores:    

000062111-1

000062112-1

000062125-1

000062113-1

000062115-1

000062116-1

000062114-1

000062117-1

000062118-1

000062119-1

000062120-1

000062121-1

000062122-1

000062123-1

000062124-1

@Wendell MenezesMenezes boa tarde!!!!!

Entendi, minha dúvida é quanto ao tempo de excursão conforme as linhas forem aumentando. Minha ideia seria ao invés de testar linha por linha, encontrar as linha que correspondam com as variáveis Dada("J2") e "Cod2" e realizar a substituição.

@Wendell Menezes Boa tarde!!!

Seria possível que a variável LR ao invés de contar quantas linhas tem contasse apenas quanta linhas com os critérios Data ("J2") e "Cod2"? 

@Wendell Menezes , boa noite!!!!

Eu gostaria em VBA.

Boa tarde pessoal,

Tenho uma planilha onde preciso converter os valores de algumas células em negativo caso 2 critérios sejam atendidos, a data e o código.

Na coluna A temos as datas, na coluna B os códigos, na coluna C, D e E os valores que preciso converter em negativo. Dessa forma para converter os valores das colunas C,D,e E em negativos é preciso que o valor da colunas A seja igual a "J2"(data digitada) e o valor da coluna B seja igual a "Cod2".

@Midori boa tarde,

Como eu faria para isso funcionar em uma Aplication.InputBox onde essa sequência de números é digitada?

Bom dia pessoal, tudo bem?

Preciso de uma ajuda em uma aplicação.

Em uma célula são inseridos uma sequencia numérica que variam de 5 até 100 números. Eu preciso que seja inserida uma virgula a cada 5 caractere para realizar uma separação.

12345123451234512345123451234512345 (sequência digitada)

12345,12345,12345,12345,12345,12345,12345 (Resultado)

@OreiaG Bom dia,

Deu certo sim, eu havia conseguido inserindo >>> sSubs = UCase(sSubs) porém da forma que você mencionou ficou mais enxuto. Obrigado!!!!!

@OreiaG Muito obrigado, precisei fazer alguns ajustes devido a planilha mas funcionou perfeitamente.

@Basole Boa tarde, tudo bem?

Desculpa reabrir o post mas apareceu uma dúvida como eu faço para a palavra que irá substituir sempre ficar toda maiúscula?

@Wendell Menezes  boa tarde,

Desculpa reabrir o tópico mas você poderia me explicar o código caso eu queira inserir 2 ou mais linhas onde modifico e como eu faria se a célula onde está o nome procurado for a ultima linha preenchida (eu criei a variável "PriLin = Planilha1.Range("F1048576").End(xlUp).Row ", porém não consegui encaixar no código de forma funcional).

Boa tarde pessoal, tudo bem?

Sou novato em VBA e preciso de uma ajuda para um comando para localizar o ultimo valor de uma serie de valores repetidos em uma coluna de uma tabela e após localizar esse valor inserir uma linha. No exemplo abaixo gostaria de localizar a ultima ocorrência do nome Paulo e abaixo inserir uma linha 

                                A          B         C

1                                         Paulo

2                                         Paulo

3                                         Lucia

4                                         Maria

5                                         Roberto

6                                         Paulo

7                            Linha inserida

@Danmorais boa tarde,

Na ajuda pois preciso que busque o valor na tabela toda e não apenas em uma coluna, mas obrigado pela atenção.

Bom dia pessoal, tudo bem?

Preciso de uma formula para buscar um valor determinado dentro de uma tabela. A coluna mês é a referencia da busca. Segue anexo a planilha.

CH Ano fiscal.xlsx

@Muca Costa boa noite,

Tentei adapta a minha necessidade mas não consegui, será que pode me ajudar?

Esse código baixa todos os email, porém eu preciso que baixe o anexo de apenas um email específico 

@Basole boa tarde, eu havia quebrado a cabeça e consegui resolver conforme abaixo mas o seu código ficou muito mais enxuto e eficiente. Muito obrigado novaente. 

Sub Procura_palavra()

Dim Entrada As Variant, Contador As Integer, UltLin As Integer, sbx As Variant, cancel As Variant


sbx = InputBox("Procurar palavra desejada")
If sbx = cancel Then 'caso cancele a busca
   Exit Sub
End If

      Cells.Find(What:=sbx, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Select
        
        Cells(1, 20) = sbx
        Cells(1, 20) = UCase(Cells(1, 20).Value)
        
Call msg5

End Sub

Sub Substitui_palava_encontrada()

Dim Entrada As Variant, Contador As Integer, UltLin As Integer




UltLin = Range("F" & Rows.Count).End(xlUp).Row - 1

For Contador = 2 To UltLin

If wsBase.Cells(Contador, 6).Value = wsBase.Cells(1, 20) Then
    'MsgBox Cells(Contador, 1).Value
    Entrada = Application.InputBox(Environ("UserName") & " - " & "Insira a palavra que irá substituir" )
    Cells(Contador, 6) = Entrada
    Cells(Contador, 6) = UCase(Cells(Contador, 6).Value)
    
End If
Next
End Sub

@Vics , boa tarde!!

Muito obrigado pela sua dica e tempo que dispôs, não era exatamente o que eu queria mas me deu uma luz para chegar na solução que preciso.

Boa tarde pessoal tudo bem?

Preciso de uma inputbox que localize uma palavra e em seguida abra outra inputbox para digitar uma nova palavra e realize a substituição. eu encontrei o código abaixo para localizar mas não conseguir fazer a segunda parte.

Sub Localiza_palavra_desejada()
sbx = InputBox("Procurar palavra desejada")
If sbx = cancel Then 'caso cancele a busca
   Exit Sub
End If

      Cells.Find(What:=sbx, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Select
      MsgBox "Palavra [ " & sbx & " ] encontrada na célula [ " & ActiveCell.Address & " ]", vbInformation
     
End Sub

@Basole Obrigado!!!!!