GTTJ

PrezadosEstou 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,

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 Sub Observaçõ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: