Olá!
Estou fazendo uma Macro estilo formulário, que irá se auto anexar e auto enviar por e-mail para usuários mediante ativada. Minha ideia é que, quando enviada, ela também contenha os códigos nos módulos e sheets porque os usuários que irão receber precisam repassa-la adiante e provavelmente não terão acesso à planilha original.
Também adicionei um código em uma sheet para automatizar hide/unhide de linhas...depois que adicionei esse código, não consigo mais salvar e anexar a planilha no email. A mensagem que recebo é "Os recursos a seguir não podem ser salvos em pastas de trabalho sem macro: Projeto do VB. Para salvar um arquivo com esses recursos, clique em Não e escolha um tipo de arquivo habilitado para macro na lista Tipo de Arquivo. Para continuar salvando como pasta de trabalho sem macro, clique em Sim."
Segue abaixo o código de envio de email, que está em um módulo, e também o código automatizado de hide/unhide linhas, que está na sheet. Esse código de anexar e enviar por email estava funcionando perfeitamente, mas depois que adicionei o código de automatização para hide/unhide linhas abaixo, ele começou a dar esse código de erro acima.
Código e-mail:
Sub RP()
'******************************************************
'Set email details; Comment out if not required
MailTo = "fulano@fulano.com"
MailSub = Range("form") & ": " & Range("Subject")
MailTxt = "I have attached " & Range("form") & Range("Subject")
'******************************************************
'Turns off screen updating
Application.ScreenUpdating = False
'Turns off screen updating
Application.ScreenUpdating = False
'Makes a copy of the active sheet and save it to
'a temporary file
ActiveSheet.Copy
Set WB = ActiveWorkbook
FileName = Range("form") & "_" & Range("Subject")
On Error Resume Next
Kill "C:" & FileName
On Error GoTo 0
WB.SaveAs FileName:=FileName
'Creates and shows the outlook mail item
Set objUserProperty = AOMailMsg.UserProperties.Add("TITUSAutomatedClassification", 1)
objUserProperty.Value = "TLPropertyRoot=ABCDE;Classification=Internal;Registered to:My Companies;"
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
.To = MailTo
.Cc = MailCC
.Bcc = MailBCC
.Subject = MailSub
.Body = MailTxt
.Attachments.Add WB.FullName
.Save
.Display
End With
'Deletes the temporary file
WB.ChangeFileAccess Mode:=xlReadOnly
Kill WB.FullName
WB.Close SaveChanges:=False
'Restores screen updating and release Outlook
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing
End Sub
Hide/Unhide linhas automaticamente
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("form").Value = "Requisição de Pessoal" Then
Rows("27:61").EntireRow.Hidden = False
Rows("14:26").EntireRow.Hidden = True
Rows("62:86").EntireRow.Hidden = True
ElseIf Range("form").Value = "Requisição de Desligamento" Then
Rows("27:61").EntireRow.Hidden = True
Rows("62:86").EntireRow.Hidden = True
Rows("14:26").EntireRow.Hidden = False
ElseIf Range("form").Value = "Promoção" Then
Rows("14:61").EntireRow.Hidden = True
Rows("62:86").EntireRow.Hidden = False
End If
End Sub
Agradeço muito qualquer ajuda!
Gabrielle
Postado : 31/08/2015 3:40 pm