Boa tarde André

Para manter a organização do fórum, não crie vários tópicos sobre o mesmo assunto.
Pensei unir este tópico a outros, mas fiquei até em dúvida, pois constatei que você tem várias tópicos sobre o mesmo assunto, contrariando as regras do fórum.

O usuário deve fazer vários testes antes de marcar o tópico como Resolvido, mas mesmo depois de trancado, se for necessário reabrir o tópico, basta enviar uma MP para um dos moderadores.

[]s

Patropi - Moderador.

desculpe, mas é que sempre surge uma nova ideia, como ja estava fechado dai abri outro,

Suponha que vc tenha isso nas celulas 10 e 20 esse comando deve lhe retornar algo assim 1020 é isso mesmo que vc pretende?

E a informação é pra pegar mesmo na planilha ativa?

Mas para teste tente trocar activesheet por Sheets("Nome da Planilha") pode ser que funcione.

Suponha que vc tenha isso nas celulas 10 e 20 esse comando deve lhe retornar algo assim 1020 é isso mesmo que vc pretende?

E a informação é pra pegar mesmo na planilha ativa?

Mas para teste tente trocar activesheet por Sheets("Nome da Planilha") pode ser que funcione.

Grato por mais esta, coloca na conta que depois eu pago. Ficou o que eu queria !!!

.Attachments.Add "C:UsersAndreDesktopPedidos" & Sheets("MAPA").Range("F1").Value & Sheets("MAPA").Range("I1").Value

Grato

Andre

Ola M.Prudencio, tem alguma dica pra isso aqui:

.Attachments.Add "C:UsersAndreDesktopPedidos Gauer" & Sheets("MAPA").Range("F1").Value & Sheets("MAPA").Range("I1").Value
.Attachments.Add "C:UsersAndreDesktopPedidos Gauer" & Sheets("MAPA").Range("F2").Value & Sheets("MAPA").Range("I2").Value
.Attachments.Add "C:UsersAndreDesktopPedidos Gauer" & Sheets("MAPA").Range("F3").Value & Sheets("MAPA").Range("I3").Value

Se eu rodar ele anexa os 3 arquivos beleza, porem eu tava aqui pensando com meus botoes, e queria que ficasse de uma forma que se a 2 linha e 3 linha estivessem vazias, entao nao daria o erro que ta dando, caso eu nao apresente o arquivo nestas linhas. Assim sendo caso a linha 2 e 3 estejam vazias, ele desconsideraria os 2 Attachment.Add. ultimos.

Pode resolver isso ?

Grato

MPrudencio, matei aqui o problema.

.Attachments.Add "C:UsersAndreDesktopPedidos Gauer" & Sheets("MAPA").Range("F1").Value & Sheets("MAPA").Range("I1").Value

If Sheets("MAPA").Range("F2").Value > 0 Then
.Attachments.Add "C:UsersAndreDesktopPedidos Gauer" & Sheets("MAPA").Range("F2").Value & Sheets("MAPA").Range("I2").Value
Else
.Display
End If

If Sheets("MAPA").Range("F3").Value > 0 Then
.Attachments.Add "C:UsersAndreDesktopPedidos Gauer" & Sheets("MAPA").Range("F3").Value & Sheets("MAPA").Range("I3").Value
Else
.Display
End If

.Display 'Send

Ja rodei e testei linha 2 cheia e 3 vazia - resultado OK

Linha 2 cheia e linha 3 cheia , resultado Ok

Linha 2 e 3 vazias - resultado OK tambem

Grato e até a proxima.

Andre

Ainda bem que nao fechei ainda este tópico.

Coloquei numa celula "I4", na mesma aba de "MAPA" o acrescimo da macro, porem esta dando o erro e ao depurar me mostar que é na .sEnvio, portanto podem me mostrar o erro , pois ja tentei aqui varias variantes.

I4 = poderá estar como Display ou Send

Sub X_Lojas()

'Setting up the Excel variables.
Dim olApp As Object
Dim olMailItm As Object
Dim iCounter As Integer
Dim Dest As Variant
Dim SDest As String
Dim Estado As String
Dim BuscaEstado As Range
Dim AbrevEstado As String

Dim sEnvio
sEnvio = ActiveSheet.Range("I4")

.....
....
...

Erro apresentado:

Erro em tempo de execucao 438
O Objeto nao aceita esta propriedade ou método

Linha da Macro onde mostra o erro:

.sEnvio

Grato

Andre

Tenho a impressao que ta faltando coisa ae

Tente assim

sEnvio = ActiveSheet.Range("I4").value

Uma dica que eu uso bastante em meus codigos, sou inciante mas vejo que isso evita muitos erros.

Declare uma variavel para a aba

Ao inves de usar activesheet.range use algo assim

Dim Wmap as worksheet
Dim SEnvio as Variant

Set Wmap = Sheets("Mapa")
SEnvio =Wmap.range("I4").value

Eu sempre que vou usar algo em uma aba especifica armazeno o nome da aba em uma variavel.

Mas eu acho que o erro é basicamente a falta do .value no final da instrução.

....

assim continua dando erro

Dim sEnvio
sEnvio = ActiveSheet.Range("I4").value

em :

.sEnvio

trava aqui

Dim Wmap As Worksheet
Dim SEnvio As Variant
Set Wmap = Sheets("Mapa")
SEnvio = Wmap.Range("I4").Value

Objeto nao aceita esta propriedade ou metodo

erro em :

.sEnvio

De novo tentou a dica anterior ao inves de activesheet usar Sheet ("Nome da Aba")

Tente as outras sugestões que passei.

Esse é o tipo de codigo que nao consigo testar pq nao uso outlook para enviar email.

Uso apenas webmail.

usei sim as 2 dicas que vc passou ve ai acima .

Coloca o codigo inteiro....

Sub X_Lojas()


'Setting up the Excel variables.
Dim olApp       As Object
Dim olMailItm   As Object
Dim iCounter    As Integer
Dim Dest        As Variant
Dim SDest       As String
Dim Estado      As String
Dim BuscaEstado As Range
Dim AbrevEstado As String
Dim Envio
    Envio = Sheets("MAPA").Range("I4").Value
   

    Estado = Application.Caller

Sheets(Estado).Visible = True

    Set BuscaEstado = ThisWorkbook.ActiveSheet.Range("A3:A29").Find(Estado, LookIn:=xlValues, LookAt:=xlWhole)
    
    If BuscaEstado Is Nothing Then
        MsgBox "Estado não localizado"
        GoTo Fim
    Else
        AbrevEstado = ThisWorkbook.Worksheets("MAPA").Cells(BuscaEstado.Row, 1).Value
    End If
    
    'Quero que aqui, ao inves de ter RJ tenha a variavel Estado que vai estar associado ao click na regiao do mapa.
    ThisWorkbook.Worksheets(AbrevEstado).Select
   
    iCounter = 1
   
    'Create the Outlook application and the empty email.
    Set olApp = CreateObject("Outlook.Application")
    Set olMailItm = olApp.CreateItem(0)
   
    'Using the email, add multiple recipients, using a list of addresses in column C.
    With olMailItm
       For iCounter = 1 To WorksheetFunction.CountA(Columns(3))
       
       ' Sheets("Email").Select
               SDest = SDest & ";" & Cells(iCounter, 3).Value
       
       Next iCounter
       
    'Do additional formatting on the BCC and Subject lines, add the body text from the spreadsheet, and send.
       .BCC = SDest
       .Subject = "Tabela de Pedidos"
       '.Body = "Ola"
        .Body = "Olá Lojista! Segue anexo nossa Tabela de Pedidos, fico no seu Aguardo." & vbCrLf & _
        "" & vbCrLf & _
        "Seu Pedido Mímimo é de R$ 600,00, a a forma de envio é F.O.B" & vbCrLf & _
        "" & vbCrLf & _
        "ATENÇÃO" & vbCrLf & _
        "" & vbCrLf & _
        "Seu Pedido somente será liberado depois de sua Aprovação, pois encaminharei um esboço do seu pedido por E-Mail." & vbCrLf & _
        "" & vbCrLf & _
        "Obrigado!" & vbCrLf & _
        "" & vbCrLf & _
        "André Luiz" & vbCrLf & _
        "Fone: (21)3564-2347" & vbCrLf & _
        "WhatsApp: (21)98799-3381" & vbCrLf & _
        "atendimento-rj@gauerdobrasil.com.br"
       
       'troque o diretorio do documento que queira enviar 'add' anexo.
       .Attachments.Add "C:UsersAndreDesktopPedidos Gauer" & Sheets("MAPA").Range("F1").Value & Sheets("MAPA").Range("I1").Value
   
 If Sheets("MAPA").Range("F2").Value > 0 Then
       .Attachments.Add "C:UsersAndreDesktopPedidos Gauer" & Sheets("MAPA").Range("F2").Value & Sheets("MAPA").Range("I2").Value
Else
       .Envio  'Display
End If
  
 If Sheets("MAPA").Range("F3").Value > 0 Then
       .Attachments.Add "C:UsersAndreDesktopPedidos Gauer" & Sheets("MAPA").Range("F3").Value & Sheets("MAPA").Range("I3").Value
Else
       .Envio  'Display
End If
       
       .Envio  'Display  'Send
   
Sheets("MAPA").Select
   
Sheets(Estado).Visible = False
   
   End With

    Exit Sub
Fim:
   'Clean up the Outlook application.
   Set BuscaEstado = Nothing
   Set olMailItm = Nothing
   Set olApp = Nothing
   
  
End Sub