Excel planilha vba statusbar mensagem colorida

Dom, 27 de Novembro de 2011 07:34 Expedito Marcondes
Imprimir


'Estas declarações do Aplicativo Microsoft Excel VBA, inserem cores e mensagem na barra de status (Statusbar
)

Option Base 1
 Declare Function FindWindow32 Lib "User32" Alias "FindWindowA" _
  (ByVal szClass$, ByVal szTitle$) As Long

Declare Function GetWindow32 Lib "User32" Alias "GetWindow" _
  (ByVal hwnd As Long, ByVal wCmd As Long) As Long

Declare Function GetClassName32 Lib "User32" Alias "GetClassNameA" _
  (ByVal hwnd As Long, ByVal lpClassName As String, _
   ByVal nMaxCount As Long) As Long

Declare Function GetDC32 Lib "User32" Alias "GetDC" _
  (ByVal hwnd As Long) As Long

Declare Function CreateFont32 Lib "gdi32" Alias "CreateFontA" _
  (ByVal h As Long, ByVal w As Long, ByVal E As Long, _
  ByVal O As Long, ByVal w As Long, ByVal I As Long, _
  ByVal u As Long, ByVal s As Long, ByVal c As Long, _
  ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, _
  ByVal PAF As Long, ByVal f As String) As Long

 

 Declare Function SelectObject32 Lib "gdi32" Alias "SelectObject" _
(ByVal hdc As Long, ByVal hObject As Long) As Long

Declare Function SetTextColor32 Lib "gdi32" Alias "SetTextColor" _
 (ByVal hdc As Long, ByVal crColor As Long) As Long

Declare Function DeleteObject32 Lib "gdi32" Alias "DeleteObject" _
 (ByVal hObject As Long) As Long

Declare Function ReleaseDC32 Lib "User32" Alias "ReleaseDC" _
  (ByVal hwnd As Long, ByVal hdc As Long) As Long

 

Sub Mensagem_em_negrito()
Dim hWndNext
Dim hWndWks32 As Long
Dim hDcWks32 As Long

Dim hFont32 As Long, hFontOld32, hFontColor32 As Long
Dim sBuff As String * 255
Dim a As Long

Const GW_CHILD As Integer = 5
Const GW_HWNDFIRST As Integer = 0
Const GW_HWNDNEXT As Integer = 2

Application.DisplayStatusBar = True
'Localiza a Janela do Excel
hWndWks32 = FindWindow32("xlmain", Application.Caption)
'Ativa a Janela
hWndNext = GetWindow32(hWndWks32, GW_CHILD)
'Ativa a Primeira Janela
hWndNext = GetWindow32(hWndNext, GW_HWNDFIRST)
a = GetClassName32(hWndNext, sBuff, 255)
hDcWks32 = GetDC32(hWndNext)
hFont32 = CreateFont32(-14, 12, 0, 0, 1000, 10, 10, 0, 0, 10, 10, 10, 10, _
"Times New Roman")       'Seq Tamanho da Fonte, Espaçamento da Fonte, Alinhamento,Textura de Negrito,Italic, Sublinhado, Riscado, SobreRiscado,,,

 
'Cor da Fonte
 hFontColor32 = SetTextColor32(hDcWks32, 8000000)
 hFontOld32 = SelectObject32(hDcWks32, hFont32)
Application.StatusBar = "EU ESTOU EM NEGRITO E COLORIDO! ! ! "
MsgBox "OLHE A BARRA DE STATUS!!!!"
 Application.StatusBar = False
 a = SelectObject32(hDcWks32, hFontOld32)
 a = ReleaseDC32(hWndNext, hDcWks32)
End Sub

 
Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.

Tags:
Última atualização em Dom, 27 de Novembro de 2011 07:40