Eu colei um mapa Jpg do Brasil em minha planilha, pois nao o tenho em Vetor.
usei varios quadradinhos em cada regiao, os dei a cada quadrado um nome e os deixei transparente. Tenho varias planilhas com os Estados e todas seguem um mesmo padrao de Layout. Essa que esta o mapa se chama Aba "MAPA". quero usar a mesma VBa abaixo para todas as Abas, mas para isso tenho que ter algo dentro da Macro que associe cada quadradinho a um Estado.
Assim preciso ao clicar no quadrado do RJ no inicio da mesma tera que ter a DIM que se associe ao Quadrado de nome RJ, assim o comando Sheets funcionaria corretamente, pois depois disto joga a Aba correspondente e a executa.
pensei em algo assim :
Din Estado
Sheets("Estado").Select ' Veja que no cod abaixo botei " SP ", pois assim esta funcionando,
Ao iniciar a Macro ela cria a memoria com nome do quadrado que foi clicado e usa no Sheets. Assim nao será preciso eu ter que fazer uma macro especifica a cada Estado do Brasil.
Se alguem puder complementar o codigo abaixo serei grato.
Andre
Sub Lojas()
Sheets("SP").Select
'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
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 Tabele 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 & vbCrLf & _
"WhatsApp: (21)98799" & vbCrLf & _
"atendimento-rj@"
'troque o diretorio do documento que queira enviar 'add' anexo.
.Attachments.Add "C:UsersAndreDesktopPedidosLojista.xlsx"
.Send
End With
'Clean up the Outlook application.
Set olMailItm = Nothing
Set olApp = Nothing
Postado : 17/12/2015 11:17 am