GTTJ
-
Total de itens
13 -
Registro em
-
Última visita
Posts postados por GTTJ
-
-
Prezados,
Boa noite,
Segue a solução:
Windows("Exemplo.xls").visible = False
Para reexibir a planilha use assim
Windows("Exemplo.xls").visible = True
Obs.: Estes exemplos funcionam no Office 2003.
Desde já agradeço, :ninja:
-
Prezados,
Bom dia,
Como faço para ocultar uma planilha específica da Barra de Tarefas do Windows por meio de VBA?
Desde já agradeço à atenção, :ninja:
-
Prezados,
Bom dia,
Segue a solução:
Tenho a seguinte macro
Option Explicit Dim assinatura As Variant Public Function pega_assinatura(ByVal sFile As String) As String Dim fso As Object Dim ts As Object Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2) pega_assinatura = ts.readall ts.Close End Function Sub Envio_Email() On Error Resume Next Dim myOlApp As Outlook.Application Dim myItem As MailItem Dim myAttachments As Attachments Set myOlApp = CreateObject("Outlook.Application") Set myItem = myOlApp.CreateItem(olMailItem) Set myAttachments = myItem.Attachments 'Esta função está sendo considerada para o Windows NT, caso for o Windows XP o caminho para o arquivo de assinatura é C:\Documents and Settings\" & Environ("username") "\Dados de Aplicativos\Microsoft\Signatures\Sem título.htm") assinatura = pega_assinatura("C:\Documents and Settings\" & Environ ("username") & "\Application Data\Microsoft\Signatures\Sem título.htm") With myItem .To = Sheets("E-MAIL").Range("h4").Value '"gsalves@contax.com.br" .Cc = Sheets("E-MAIL").Range("h11").Value '"gsalves@contax.com.br" .Subject = "Relatório de Aderência Atualizado até " & Sheets("E-MAIL").Range("H9").Value 'Além de colocar todo o conteúdo em formato HTML estas linhas pegam a assina- 'tura na minha máquina. .HTMLBody = "<html><body>" & Sheets("E-MAIL").Range("H17").Value & "<P>" & Sheets("E- MAIL").Range("H19").Value & _ "<P>" & Sheets("E-MAIL").Range("H21").Value & "<P>" & Sheets("E-MAIL").Range ("H23").Value & _ "<P>" & Sheets("E-MAIL").Range("H25").Value & assinatura & "</body></html>" myItem.SentOnBehalfOfName = Sheets("E-MAIL").Range("h2").Value myAttachments.Add Range("L1").Value .Display SendKeys ("%r"), True End With Windows("MATRIZ DE ADERÊNCIA.xls").Activate End SubObservações:
1º Este código além de capturar a assinatura que você tenha cadastrado no Outlook ela preenche os Campos "De", "Para", "Cc", "Assunto" e "Anexo";
2º O Comando SendKeys ("%r"), True evita a maldita mensagem de segurança do Outlook 2003;
3º Para que este código funcione é necessário referenciar a biblioteca do Outlook 2003, ou seja, Ferramentas\Referências no editor de VBA e marcar a opção Microsoft Office Outlook 11.0 Object Library.
Desde já agradeço à atenção de todos. :ninja:
-
Prezados,
Boa noite,
Tenho uma macro que pega informações de uma Sheet e coloca no corpo do e-mail.
O Que eu quero é que além de pegar esta informação é que coloque a minha assinatura
configurada no meu Outlook, ao invés de colocar uma assinatura sem formatação, como texto.
Alguém pode me ajudar?
Desde já agradeço à atenção, :ninja:
-
Prezados,
Boa noite,
Como faço para Ocultar um Processo, e não o Aplicativo, do Gerenciador de Tarefas do Windows por meio de VBA?
Por que peço isso ? Solicito, pois tenho um programa na minha empresa que parece que
verifica o Gerenciador e se for veradeiro que já tem uma instância aberta o mesmo me retorna com a mensagem informando que não irá abrir. Portanto queria contornar este problema. Já ten-tei ocultar o Aplicativo do Gerenciador, mas se sucesso.
Desde já agradeço à atenção, :ninja:
-
Prezados,
Boa noite,
Como faço para Zipar um arquivo por meio de VBA?
Obs: Zipar com o ZipCentral.
Desde já agradeço à atenção, :ninja:
-
Prezados,
Boa noite,
o link: http://inanyplace.blogspot.com/2009/03/out...o-aviso-de.html me mostra uma forma.
Outra forma de se fazer isso é após o comando Display escrever a seguinte linha: sendkeys ("%R"), True.
Obs: Este comando emula o Outlook, mas mesmo assim evita de aparecer a maldita mensagem de Segurança do Outlook, pelo menos na versão 2003.
Att,
-
Prezados,
Boa noite,
Como faço para me livrar da Mensagem de Segurança do Outlook 2003 quanto tento enviar um e-mail automático por meio de VBA?
Obs.: Quero utilizar somente VBA, de modo que não venha a utilizar nenhum programa sobressalente.
Desde já agardeço à atenção,
-
Prezados,
Boa noite,
A Resposta a minha pergunta foi apenas acrescentar a linha na minha macro:
myItem.SentOnBehalfOfName = Sheets("E-MAIL").Range("h2").Value 'Célula onde consta o remetente que desejo preenhcher o Campo "De" do Outlook.
Desde já agradeço a atenção de todos.
-
Prezados,
boa tarde,
Como faço para preencher o Campo "De" do Outloock por meio de vba?
Obs.: A Versão do Outloock é 2003.
Desde já agradeço a atenção, :unsure:
-
Prezados,
boa tarde,
A resposta é colocar 2 subrotinas, uma dentro da outra. Segue o exemplo abaixo:
Sub Plan_Nova()
'1º Rótulo
OCORREUERRO:
'Acessa a outra Rotina
Plan_Nova1
'Faz uma segunda verificação. E caso constatado que não existe uma planilha nova aberta, então força o desvio da macro para o rótulo acima e consequentemente a segunda macro vai ser executada novamente (Uma espécie de loop).
If range("a1").value = 1 then
Goto OCORREUERRO
End If
'Coloque o código a ser executado, caso exista uma planilha do excel aberta e ainda não salva aquí
End Sub
Sub Plan_Nova1()
'Variável
Dim title As String
'Armadilha de erros, caso houver
On Error GoTo OCORREUERRO1
'Atribuição da vaiável há uma planilha nova e ainda não salva
title = "Microsoft Excel - Pasta1"
'Pondo focu na planilha nova
AppActivate title
'Continuação da armadilha de erro, se houver
OCORREUERRO1:
'Aquí é feita a primeira verificação, caso a mesma se constate que não há uma nova planilha então o código "Zerara" o erro e sairá desta rotina e voltando para a primeira. Na primeira será feito a segunda verificação que por sua vez jogará para o rótulo, forçando assim a execução desta rotina novamente.
If Err > 0 Then
Range("a1").Value = 1
On Error GoTo 0
Exit Sub
Else
Range("a1").Value = 0
End If
End Sub :ninja:
-
Prezados,
Boa tarde,
Alguém sabe me informar como façõ para criar um "loop" por meio de vba onde este verifica se há uma nova planilha aberta e ainda não salva, ou seja a mesma vai conter o título de "Microsoft Excel - Pasta1".
Obs: Esta planilha ainda não salva esta em instância diferente da planilha que contiver a macro.Se algum de vocês souberem acessar o Gerenciador do Windows por meio de vba e imprimir os processos atuais em uma sheet eu também fico grato.
Att, :rolleyes:
Form dá Erro 13 Tipos Incompátiveis
em VBA
Postado · Editado por GTTJ
Prezados
Estou tentando executar a Macro abaixo, porém dá erro 13. Meu Office é 2010 de 64bits. Ela contém API para executar o Menu no formulário.
Obs.: Peguei esta macro na net e irei personalizar para o que estou querendo fazer.
A Macro aponta para a parte em vermelho:
'Font enumeration types
Public Const LF_FACESIZE = 32
Public Const LF_FULLFACESIZE = 64
Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName(LF_FACESIZE) As Byte
End Type
Type NEWTEXTMETRIC
tmHeight As Long
tmAscent As Long
tmDescent As Long
tmInternalLeading As Long
tmExternalLeading As Long
tmAveCharWidth As Long
tmMaxCharWidth As Long
tmWeight As Long
tmOverhang As Long
tmDigitizedAspectX As Long
tmDigitizedAspectY As Long
tmFirstChar As Byte
tmLastChar As Byte
tmDefaultChar As Byte
tmBreakChar As Byte
tmItalic As Byte
tmUnderlined As Byte
tmStruckOut As Byte
tmPitchAndFamily As Byte
tmCharSet As Byte
ntmFlags As Long
ntmSizeEM As Long
ntmCellHeight As Long
ntmAveWidth As Long
End Type
' ntmFlags field flags
Public Const NTM_REGULAR = &H40&
Public Const NTM_BOLD = &H20&
Public Const NTM_ITALIC = &H1&
' tmPitchAndFamily flags
Public Const TMPF_FIXED_PITCH = &H1
Public Const TMPF_VECTOR = &H2
Public Const TMPF_DEVICE = &H8
Public Const TMPF_TRUETYPE = &H4
Public Const ELF_VERSION = 0
Public Const ELF_CULTURE_LATIN = 0
' EnumFonts Masks
Public Const RASTER_FONTTYPE = &H1
Public Const DEVICE_FONTTYPE = &H2
Public Const TRUETYPE_FONTTYPE = &H4
Public Const WESTERN_CHARSET = 0
Public Const DEFAULT_CHARSET = 1
Public Const SYMBOL_CHARSET = 2
Public Const JAPANESE_CHARSET = 128
Public Const HANGEUL_CHARSET = 129
Public Const GB2312_CHARSET = 134
Public Const CHINESEBIG5_CHARSET = 136
Public Const OEM_CHARSET = 255
Public Const JOHAB_CHARSET = 130
Public Const HEBREW_CHARSET = 177
Public Const ARABIC_CHARSET = 178
Public Const GREEK_CHARSET = 161
Public Const TURKISH_CHARSET = 162
Public Const THAI_CHARSET = 222
Public Const EASTEUROPE_CHARSET = 238
Public Const Cyrillic_CHARSET = 204
Public Const MAC_CHARSET = 77
Public Const BALTIC_CHARSET = 186
Declare PtrSafe Function EnumFontFamilies Lib "gdi32" Alias _
"EnumFontFamiliesA" _
(ByVal hDC As Long, ByVal lpszFamily As String, _
ByVal lpEnumFontFamProc As Long, LParam As Any) As Long
Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As Long, _
ByVal hDC As Long) As Long
Function EnumFontFamProc(lpNLF As LOGFONT, lpNTM As NEWTEXTMETRIC, _
ByVal FontType As Long, LParam As ListBox) As Long
Dim FaceName As String
Dim FullName As String
FaceName = StrConv(lpNLF.lfFaceName, vbUnicode)
LParam.AddItem Left$(FaceName, InStr(FaceName, vbNullChar) - 1)
EnumFontFamProc = 1
End Function
Sub FillListWithFonts(LB As ListBox)
Dim hDC As Long
LB.Clear
hDC = GetDC(LB.hWnd)
EnumFontFamilies hDC, vbNullString, AddressOf EnumFontFamProc, LB 'Erro 13 Tipos Incompativeis
ReleaseDC LB.hWnd, hDC
End Sub
Obrigado desde já pela atenção,