SaberExcel - Aprenda Excel VBA, Site sobre macros, funções, fórmulas e planilhas do Excel VBA planilhas prontas e apostilas para download

Saberexcel - o site de quem precisa aprender macros ms excel vba

'Estas declarações com as macros do Aplicativo MS Excel VBA, faz piscar a tela.

Public Const R2_XORPEN = 7
Public Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetWindowRect Lib "User32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function GetWindowDC Lib "User32" (ByVal hwnd As Long) As Long
Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Declare Function SetROP2 Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

 Sub Piscar_Tela()
Dim hwnd, DC As Long
Dim Pos As RECT
Dim I As Integer
 
hwnd = FindWindow("xlmain", Application.Caption)
DC = GetWindowDC(hwnd)
GetWindowRect hwnd, Pos
SetROP2 DC, R2_XORPEN
 
For I = 1 To 5
    Rectangle DC, 0, 0, Pos.Right, Pos.Bottom
    Sleep (100)
    Rectangle DC, 0, 0, Pos.Right, Pos.Bottom
    If I <> 5 Then
        Sleep (100)
    Else
        Exit Sub
    End If
Next I

End Sub
'- - - - - - - - - - - - - - - - - - -
'Estas declarações com as macros abaixo acende a paga o teclado
Const VK_CAPITAL = &H14
Const VK_NUMLOCK = &H90
Const VK_SCROLL = &H91
Const VK_USED = VK_SCROLL

Private Type KeyboardBytes
     kbByte(0 To 255) As Byte
End Type

Private Declare Function GetKeyState Lib "user32? (ByVal nVirtKey As Long) As Long" ()
Private Declare Function GetKeyboardState Lib "user32? (kbArray As KeyboardBytes) As Long" ()
Private Declare Function SetKeyboardState Lib "user32? (kbArray As KeyboardBytes) As Long" ()
Private Declare Sub Sleep Lib "kernel32? (ByVal dwMilliseconds As Long)" ()
Dim kbArray As KeyboardBytes, CapsLock As Boolean, kbOld As KeyboardBytes
 
Sub Piscar()
For I = 0 To 5
    GetKeyboardState kbOld
    Apagar VK_CAPITAL
    Apagar VK_NUMLOCK
    Apagar VK_SCROLL
    Sleep 1000
    Acender VK_NUMLOCK
    Sleep 100
    Acender VK_CAPITAL
    Sleep 100
    Acender VK_SCROLL
    Sleep 300
    Apagar VK_NUMLOCK
    Sleep 100
    Apagar VK_CAPITAL
    Sleep 100
    Apagar VK_SCROLL
    Sleep 500
    Acender VK_NUMLOCK
    Acender VK_SCROLL
    Sleep 200
    Apagar VK_NUMLOCK
    Apagar VK_SCROLL
    Sleep 200
    Acender VK_NUMLOCK
    Acender VK_SCROLL
    Sleep 200
    Apagar VK_NUMLOCK
    Apagar VK_SCROLL
    Sleep 200
    Acender VK_CAPITAL
    Sleep 200
    Apagar VK_CAPITAL
    Sleep 200
    Acender VK_CAPITAL
    Sleep 200
    Apagar VK_CAPITAL
    Sleep 200
    Acender VK_NUMLOCK
    Acender VK_SCROLL
    Sleep 200
    Apagar VK_NUMLOCK
    Apagar VK_SCROLL
    Sleep 200
    Acender VK_NUMLOCK
    Acender VK_SCROLL
    Sleep 200
    Apagar VK_NUMLOCK
    Apagar VK_SCROLL
    Sleep 200
    Acender VK_CAPITAL
    Sleep 400
    Apagar VK_CAPITAL
    Sleep 200
    Acender VK_SCROLL
    Sleep 100
    Acender VK_CAPITAL
    Sleep 100
    Acender VK_NUMLOCK
    Sleep 300
    Apagar VK_NUMLOCK
    Sleep 100
    Apagar VK_CAPITAL
    Sleep 100
    Apagar VK_SCROLL
Next I
Voltar
End Sub

Sub Acender(vkKey As Long)
    GetKeyboardState kbArray
    kbArray.kbByte(vkKey) = 1
    SetKeyboardState kbArray
End Sub

Sub Apagar(vkKey As Long)
    GetKeyboardState kbArray
    kbArray.kbByte(vkKey) = 0
    SetKeyboardState kbArray
End Sub
'- - - - - - - - - - - -
Sub Voltar()
    SetKeyboardState kbOld
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.