如何用vba在电脑屏幕的中央倒计时？

利用gdi函数可以实现在屏幕上写字，结合其它的函数可以做出在电脑屏幕上倒计时的效果，代码如下：

Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal nXStart As Long, ByVal nYStart As Long, ByVal lpString As String, ByVal cchString As Long) As Long
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function UpdateWindow Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function InvalidateRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT, bErase As Long) As Long
Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As SIZE) As Long
Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long
Declare Function WindowFromDC Lib "user32" (ByVal hdc As Long) As Long
Const WM_ERASEBKGND = &H14
Const WM_PAINT = &HF
Const SM_CXSCREEN = 0
Const SM_CYSCREEN = 1
Public Const LF_FACESIZE = 32
Public Const DEFAULT_CHARSET = 1
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(0 To LF_FACESIZE - 1) As Byte
        lfFaceName As String
End Type
Type RECT
    left As Long
    top As Long
    right As Long
    bottom As Long
End Type
Type SIZE
    cx As Long
    cy As Long
End Type
Sub QQ1722187970()
    Dim oFont As LOGFONT
    Dim tRect As RECT
    '设置要使用的字体的格式
    With oFont
        .lfFaceName = "微软雅黑"
        .lfHeight = 100
        .lfWidth = 100
        .lfWeight = 700
    End With
    Dim tSize As SIZE
    Dim x, y
    x = GetSystemMetrics(SM_CXSCREEN)
    y = GetSystemMetrics(SM_CYSCREEN)
    Dim hdc As Long
    hdc = GetDC(Excel.Application.hWnd)
    Dim str As String
    '用红色书写文字
    SetTextColor hdc, vbRed
    '设置字体的背景色
    SetBkColor hdc, vbYellow
    '创建字体
    hFont = CreateFontIndirect(oFont)
    '将创建的字体添加到DC中
    SelectObject hdc, hFont
    For i = 10 To 1 Step -1
        Excel.Application.Wait Now + TimeValue("0:0:1")
        str = i
        TextOut hdc, x / 3, y / 4, str, Len(str)
        Debug.Print InvalidateRect(0, tRect, True)
'        UpdateWindow Excel.Application.hWnd
    Next i
    DeleteObject hFont
    ReleaseDC 0, hdc
    Excel.Application.Wait Now + TimeValue("0:0:1")
    UpdateWindow Excel.Application.hWnd
End Sub