html 状态栏 显示文字颜色,请教：设置Excel状态栏文字的颜色

'设置状态栏字符红色

--------------------------------------------------------------------------------

Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Public Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long

Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long

'lngColor = 颜色 strMsg=显示文字

Public Sub StatusBarX(ByVal lngColor As Long, Optional strMsg As String)

Dim hEXCEL4 As Long

Dim hDcExcel4 As Long, lngX As Long

Const SM_CYCAPTION = 4

Application.StatusBar = ""

If strMsg = "" Then strMsg = "正在计算请稍等...."

hEXCEL4 = EXCEL4(Application.Caption) '

hDcExcel4 = GetDC(hEXCEL4) 'dc

SetTextColor hDcExcel4, lngColor

lngX = GetSystemMetrics(SM_CYCAPTION) '窗口标题的高度

TextOut hDcExcel4, lngX, 2, strMsg, LenB(StrConv(strMsg, vbFromUnicode))

ReleaseDC hEXCEL4, hDcExcel4

End Sub

Public Property Get EXCEL4(strCaption As String) As Long

EXCEL4 = FindWindowEx(FindWindowA("XLMAIN", strCaption), ByVal 0&, "EXCEL4", vbNullString)

End Property

Sub test()

StatusBarX 1000, "宏通VBA软件工作室欢迎您：http://www.vbasoft.com/"

End Sub