Dim lSuccess As Long, hWndChild As Long
  Dim sPrintText As String
  sPrintText = "Print this text"
  hWndChild = FindWindowEx(Application.hwnd, ByVal 0&, "EXCEL4", "")
  MsgBox hWndChild
  lSuccess = TextOut(hWndChild, 1, 1, sPrintText, Len(sPrintText))
  MsgBox lSuccess

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type PAINTSTRUCT
    hdc As Long
    fErase As Long
    rcPaint As RECT
    fRestore As Long
    fIncUpdate As Long
    rgbReserved(32) As Byte
End Type

Private Const DT_BOTTOM = &H8
Private Const DT_CENTER = &H1
Private Const DT_LEFT = &H0
Private Const DT_RIGHT = &H2
Private Const DT_TOP = &H0
Private Const DT_VCENTER = &H4
Private Const DT_WORDBREAK = &H10

Private Declare Function GetClientRect Lib "user32" (ByVal lhwnd As Long, lpRect As RECT) As Long
Private Declare Function BeginPaint Lib "user32" (ByVal lhwnd As Long, lpPaint As PAINTSTRUCT) As Long
Private Declare Function EndPaint Lib "user32" (ByVal lhwnd As Long, lpPaint As PAINTSTRUCT) As Long
Private 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
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function TextOut Lib "gdi32.dll" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Sub MyDraw()
  Dim sText As String, lSucces As Long, hWndChild As Long, psPaint As PAINTSTRUCT, rcCell As RECT, hdcDraw As Long
  sText = "Print this text"
  hWndChild = FindWindowEx(Application.hWnd, ByVal 0&, "EXCEL2", "")
  hWndChild = FindWindowEx(hWndChild, ByVal 0&, "MsoCommandBar", "Строка состояния")
  hWndChild = FindWindowEx(hWndChild, ByVal 0&, "MsoWorkPane", "Строка состояния")
  'hWndChild = FindWindowEx(hWndChild, ByVal 0&, "NUIPane", "")
  'hWndChild = FindWindowEx(hWndChild, ByVal 0&, "NetUIHWND", "")
  Call GetClientRect(hWndChild, rcCell)
  hdcDraw = BeginPaint(hWndChild, psPaint)
  lSucces = DrawText(hdcDraw, sText, Len(sText), rcCell, DT_LEFT)
  hdcDraw = EndPaint(hWndChild, psPaint)
End Sub

Option Explicit

Private StatusBarState As Boolean
Private EnableEventsState As Boolean
Private ScreenUpdatingState As Boolean
Private FULLS_CHAR As String
Private FRAME_CHAR As String
Private SPACE_CHAR As String
Private Const NUM_BAR As Integer = 50
Private Const MAX_LEN As Integer = 255

Private Declare Sub Sleep Lib "kernel32" (ByVal milliseconds As Long)
Private Sub Class_Initialize()
  StatusBarState = Application.DisplayStatusBar
  EnableEventsState = Application.EnableEvents
  ScreenUpdatingState = Application.ScreenUpdating
  FULLS_CHAR = ChrW(9609)
  FRAME_CHAR = ChrW(9597)
  SPACE_CHAR = ChrW(9620)
  'Application.DisplayStatusBar = True
  'Application.ScreenUpdating = False
  'Application.EnableEvents = False
End Sub
Public Function Refresh(ByVal Value As Integer, Optional ByVal MaxValue As Integer = 0, Optional ByVal Status As String = "", Optional ByVal ShowPercent As Boolean = True) As String
  Dim Display As String
  If Value < 0 Or MaxValue < 0 Or (Value > 100 And MaxValue = 0) Then Exit Function
  If MaxValue > 0 Then Value = Int((Value * 100) / MaxValue) + IIf(Int((Value * 100) / MaxValue) = (Value * 100) / MaxValue, 0, 1)
  Display = String(Int(Value / (100 / NUM_BAR)), FULLS_CHAR)
  Display = Display & String(NUM_BAR - Int(Value / (100 / NUM_BAR)), SPACE_CHAR)
  Display = Status & "  " & FRAME_CHAR & Display & FRAME_CHAR
  If ShowPercent = True Then Display = Display & "(" & Value & "%)"
  If Len(Display) > MAX_LEN Then Display = Right(Display, MAX_LEN)
  Refresh = Display
End Function
Public Sub WaitTime(ByVal Time As Integer)
  Dim I As Integer
  For I = 1 To NUM_BAR
    Application.StatusBar = Refresh(I, NUM_BAR, "Execute Query", True)
    Sleep CInt(Time * 1000# / NUM_BAR)
  Next
End Sub
Private Sub Class_Terminate()
  Application.StatusBar = False
  'Application.DisplayStatusBar = StatusBarState
  'Application.ScreenUpdating = ScreenUpdatingState
  'Application.EnableEvents = EnableEventsState
End Sub

Option Explicit

Global Thread_ID As Long

Public Declare Sub Sleep Lib "kernel32" (ByVal milliseconds As Long)

Private Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function AttachThreadInput Lib "user32" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
Function Start(Time As Integer) As String
  Dim ThreadID As Long
  Thread_ID = CreateThread(ByVal 0&, ByVal 0&, AddressOf Start_ProgressBar, Time, 0, ThreadID)
  'Call Start_ProgressBar(Time)
  Start = CStr(Time)
End Function
Public Sub Start_ProgressBar(Time As Integer)
  Dim pbExes As ProgressBar1
  Set pbExes = New ProgressBar1
  Call pbExes.WaitTime(Time)
  'Set pbExes = Nothing
  'CloseHandle Thread_ID
End Sub