Exemples de fonctions API

Pour utiliser les API en VBA, il suffit de recopier la déclaration de la fonction (ligne Declare function...) dans un module standard, puis d'utiliser la fonction dans une macro VBA.

ExitWindowsEx

La fonction ExitWindowsEx de la dll user32 commande la fermeture de Windows, la fermeture de l'ordinateur ou son rebootage :

Declare Function quitter Lib "user32" Alias "ExitWindowsEx" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long

Sub ferme_windows()
param = InputBox("choix du type de fermeture : " & _
Chr(13) & "0 pour fermer Windows" & _
Chr(13) & "1 pour fermer l'ordinateur" & _
Chr(13) & "2 pour rebooter" & _
Chr(13) & "4 pour fermer les applications récalcitrantes")
Chr(13) & "8 pour fermer l'alimentation du PC" & _
Chr(13) & "0+4+2 pour fermer les applications récalcitrantes et rebooter")
If param = "" Then Exit Sub
Call quitter(param, 0)
End Sub

GetUserNameA

La fonction GetUserNameA de la dll advapi32 renvoie le nom de l'utilisateur courant de l'ordinateur :

Declare Function nom_utilisateur Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Sub nom_de_l_utilisateur()
Dim tampon As String
tampon = Space(50)
Call nom_utilisateur(tampon, 51)
MsgBox WorksheetFunction.Substitute(tampon, " ", "")
End Sub

Le nom retourné est le nom de l'utilisateur de Windows.
Ce n'est pas forcément le même que l'utilisateur d'Excel qui est renvoyé par
MsgBox Application.UserName.

WNetGetUserA

La fonctions WNetGetUserA de la dll mpr renvoie le nom d'utilisateur réseau :

Declare Function logon Lib "mpr.dll" Alias "WNetGetUserA" (ByVal lpszLocalName As String, ByVal lpszUserName As String, lpcchBuffer As Long) As Long

Sub nom_réseau()
Dim tampon As String
tampon = String(30, " ")
Call logon(vbNullString, tampon, 31)
tampon = Left$(tampon, InStr(1, tampon, Chr$(0)) - 1)
MsgBox tampon
End Sub

GetComputerNameA

La fonctions GetComputerNameA de la dll kernel32 renvoie le nom de l'ordinateur :

Declare Function nom_ordi Lib "kernel32" Alias "GetComputerNameA" (ByVal lbbuffer As String, nsize As Long) As Long

Sub nom_de_l_ordinateur()
Dim zaza As String
zaza = Space(50)
Call nom_ordi(zaza, 51)
MsgBox Left(zaza, InStr(1, zaza, Chr(0)) - 1)
End Sub

La macro définit un buffer de 50 espaces, nommé zaza, dans lequel la fonction GetComputerNameA (renommée nom_ordi) va placer le nom de l'ordinateur.
Il suffit d'éliminer les espaces en trop pour le récupérer.

Beep et MessageBeep

Les fonctions Beep de la dll kernel32 et MessageBeep de user32 font émettre un bip à l'ordinateur :

Declare Function beep_api Lib "kernel32" Alias "Beep" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Declare Function MessageBeep Lib "user32" (ByVal wType As Long) As Long

Sub bipbip()
Call beep_api(1000, 10)
Application.Wait (Now + 3 / 3600 / 24)
Call MessageBeep(&H10&)
End Sub

Les paramètres de la fonction beep, fréquence en Hz et durée en millisecondes, sont ignorés par Windows 95.
En VBA, on peut utiliser directement l'instruction beep. Avec Windows 95, le son sera le même que celui de l'API Beep :
Sub bipbipbip()
Beep
End Sub

autre exemple avec MessageBeep :
Declare Function beep_api Lib "kernel32" Alias "Beep" _
(ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

Sub bipbip()
For freq = 0 To 3000 Step 10
Call beep_api(freq, 10)
Next
For freq = 3000 To 0 Step -10
Call beep_api(freq, 10)
Next
End Sub

WinExec

La fonction WinExec de la dll kernel32 se charge de lancer un programme executable .exe :

Declare Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long

Sub lance_explotateur()
WinExec "Explorer.exe c:\", 10
End Sub

Dans cet exemple, il n'est pas nécécessaire d'indiquer le chemin d'accès à explorer, la fonction va le chercher dans le répertoire contenant la macro, dans le répertoire en cours, puis dans le répertoire Windows.

ShowCursor

La fonction ShowCursor de la dll user32 permet de masquer ou d'afficher le curseur de la souris :

Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long

Sub cache_souris()
Call ShowCursor(False)
Application.Wait (Now + 5 / 24 / 3600)
Call ShowCursor(True)
End Sub

La macro cache d'abord le curseur de la souris Call ShowCursor(False) puis l'affiche à nouveau après 5 secondes Call ShowCursor(True).

mouse_event

La fonction mouse_event de la dll user32 permet de déplacer le curseur de la souris :

Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy
As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

Sub bouge_souris()
Call mouse_event(&H8000 Or &H1, 65535 / 2, 65535 / 2, 0, 0)
End Sub
La macro place la souris au centre de l'écran (les coordonné du pointeur sont calculées dans une échelle qui affecte 65535 unités à la largeur de l'écran et 65535 unités à sa longueau.

On peut ainsi faire décrire un cercle à la souris :
Sub petit_tour()
For num = 1 To 1000
Call mouse_event(&H8000 Or &H1, 30000 * (1 + 0.8 * Cos(num * 0.00628)), 30000 * (1 + 0.8 * Sin(num * 0.00628)), 0, 0)
Application.Wait Now + 0.05 / 24 / 3600
Next
End Sub

GetCursorPos

La fonction GetCursorPos de la dll user32 retourne les coordonnées du curseur de la souris :

Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Type POINTAPI
x As Long
y As Long
End Type

Sub coordonnées()
Dim point As POINTAPI
GetCursorPos point
MsgBox "la souris est en " & point.x & " / " & point.y
End Sub

Pour obtenir des coordonnées précises, il peut être utile de passer en plein écran avec Application.DisplayFullScreen = True.

GetClipCursor

La fonction GetClipCursor de la dll user32 retourne les coordonnées du rectangle dans lequel le curseur de la souris peut se déplacer. C'est généralement la taille de l'écran (mais certaines applications peuvent lmimiter le champ d'action de la souris) :

Declare Function GetClipCursor Lib "user32" (lprc As rect) As Long
Type rect
      Left As Long
      Top As Long
      Right As Long
      Bottom As Long
End Type

Sub taille_écran()
Dim rectg As rect
Call GetClipCursor(rectg)
MsgBox rectg.Right - rectg.Left & " x " & rectg.Bottom - rectg.Top
End Sub

La fonction GetClipCursor place dans un objet de type rect (ici nommé rectg) les coordonnées en pixels du rectangle dans lequel la souris est autorisée à évoluer.
Ce rectangle peut être modifié par la fonction ClipCursor.

sndPlaySound

La fonction sndPlaySound de la dll winmm lance un fichier son :

Declare Function joue Lib "winmm.dll" Alias _
"sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Sub applaudissements()
Call joue("C:\applaud.wav", 0)
End Sub

La macro lance le fichier son applaud.wav. Voir aussi d'autres techniques pour lancer un fichier son.

InternetOpen

La fonction InternetOpen de la dll wininet permet d'ouvrir internet et de lire des pages web, cliquez ici.

GetVersion

La fonction GetVersion de la dll kernel32 permet de reconnaître la version de Windows employée :

Declare Function WinVersion Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Type OSVERSIONINFO
     dwOSVersionInfoSize As Long
     dwMajorVersion As Long
     dwMinorVersion As Long
     dwBuildNumber As Long
     dwPlatformId As Long
     szCSDVersion As String * 128
End Type

Private Sub version_windows()
Dim OS As OSVERSIONINFO
OS.dwOSVersionInfoSize = Len(OS)
Call WinVersion(OS)
Select Case OS.dwMajorVersion & "." & OS.dwMinorVersion
Case Is = "4.0"
numver = "95"
Case Is = "4.10"
numver = "98"
Case Is = "4.90"
numver = "Me"
Case Is = "5.0"
numver = "2000"
Case Is = "5.1"
numver = "XP"
End Select
MsgBox "Windows " & numver
End Sub

La fonction GetVersionExA place dans un objet de type OSVERSIONINFO (que nous avons nommé OS) les caractéristiques du système d'exploitation.
Ces données sont lues dans OS.dwMajorVersion et OS.dwMinorVersion qui renvoient par exemple respectivement 4 et 10 pour Windows 98.
(GetVersionExA remplace GetVersion).

renvoie l'adresse du répertoire de Windows (GetWindowsDirectory de kernel32)

Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" ( _
ByVal lpBuffer As String, _
ByVal nSize As Long) As Long
Sub rep_windows()
Dim pointeur As String * 200
Call GetWindowsDirectory(pointeur, 200)
MsgBox Left(pointeur, InStr(pointeur, Chr(0)) - 1)
End Sub

GetWindowsDirectory renvoie dans un tampon de longueur 200 l'adresse du répertoire de Windows.

le nom de l'imprimante par défaut (GetProfileString de kernel32)

Private Declare Function GetProfileString Lib "kernel32.dll" _
    Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, _
    ByVal lpDefault As String, ByVal lpReturnedString As String, _
    ByVal nSize As Long) As Long

Sub imprimante_défaut()
Dim zaza As String * 254
Dim imprimante As String
GetProfileString "windows", "device", ",,,", zaza, 254
MsgBox Left(zaza, InStr(zaza, Chr(0)) - 1)
End Sub

A quelle application est associé un fichier ? (FindExecutableA de shell32)

A partir de l'adressse d'un fichier, la fonction FindExecutableA de la dll Shell32 renvoie l'adresse complète de l'executable auquel le fichier est associé.

Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" _
(ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long

Sub association()
Dim buff As String
fich = Application.GetOpenFilename
buff = Space(150)
FindExecutable fich, vbNullString, buff
appli = Left(buff, InStr(buff, Chr(0)) - 1)
MsgBox fich & Chr(10) & " est associé à " & Chr(10) & appli
End Sub

Télécharger un fichier ? (DoFileDownload de shdocvw)

La fonction ouvre la boîte de dialogue de téléchargement de fichiers.
Declare Function DoFileDownload Lib "shdocvw.dll" (ByVal lpszFile As String) As Long
Sub download()
DoFileDownload StrConv("http://jacxl.free.fr/cours_xl/accueil_xl.html", vbUnicode)
End Sub

Emprisonner le curseur de la souris dans un rectangle (GetClipCursor et ClipCursor de user32)

La fonction ClipCursor de la dll user32 permet de limiter le champ d'action de la souris à un rectangle défini par ses coordonnées en pixel. Les coordonnées sont transmises à la fonction par le biais d'un objet de type RECT.
Attention, prévoyez le moyen de libérer la souris ! Une fois la souris emprisonnée, vous risquez de ne plus pouvoir accéder aux barres d'outils et de menus. Sauf pour les experts du clavier, il ne resterait plus qu'à rebooter (touche windows).
Dans l'exemple qui suit, la souris n'est emprisonnée que pendant dix secondes. N'interrompez pas la macro pendant les dix secondes !

Declare
Declare Function GetClipCursor Lib "user32" (lprc As RECT) As Long
Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Type RECT
      Left As Long
      Top As Long
      Right As Long
      Bottom As Long
End Type

Sub souris_en_prison()
Dim rect_ini As RECT
Dim nouv_rect As RECT
Call GetClipCursor(rect_ini)
nouv_rect.Top = 100
nouv_rect.Left = 100
nouv_rect.Right = 400
nouv_rect.Bottom = 400
Call ClipCursor(nouv_rect)
Application.Wait Now + 10 / 3600 / 24
Call ClipCursor(rect_ini)
End Sub

La macro utilise GetClipCursor pour enregistrer la taille de l'écran dans un objet de type RECT (rect_ini). rect_ini sera utilisé en fin de macro pour restaurer la liberté de mouvements de la souris.
La macro utilise ensuite ClipCursor pour restreindre le champ d'action du curseur à un carré de coordonnées 100, 100 ; 400, 400.

Modifier la date ou l'heure système (GetSystemTime et SetSystemTime de kernel32)

La fonction GetSystemTime renvoie dans une variable de type SYSTEMTIME la date et l'heure système. La fonction SetSystemTime permet de les modifier :

Declare Function SetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME) As Long
Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

Sub jours_et_heures()
Dim date_heure As SYSTEMTIME
GetSystemTime date_heure
date_heure.wHour = date_heure.wHour - 1
SetSystemTime date_heure
GetSystemTime date_heure
MsgBox "L'heure système a été avancée d'une heure, il est maintenant " & date_heure.wHour & " heures et " & date_heure.wMinute & " minutes"
End Sub

Activer le pavé numérique (GetKeyboardState et SetKeyboardState de user32)

La fonction GetKeyboardState de la dll user32 envoie dans la variable tableau lpkeystate la liste de l'état de toutes les touches du clavier.
La fonction SetKeyboardState de la dll user32 place les touches du clavier dans l'état qui est indiqué dans la variable lpKeyState.
Il suffit donc d'enregistrer dans une variable "clavier" l'état de l'ensemble des touches du clavier par GetKeyboardState, de modifier dans la variable "clavier" celle qui correspond à la touche de verrouillage du pavé numérique, puis de réingecter "clavier" (modifié) grace à SetKeyboardState :

Declare Function GetKeyboardState Lib "user32" (lpKeyState As pByte) As Long
Declare Function SetKeyboardState Lib "user32" (lpKeyState As pByte) As Long
Type pByte
touche(0 To 255) As Byte
End Type
Dim clavier As pByte

Sub pavnum()
Call GetKeyboardState(clavier)
clavier.touche(vbKeyNumlock) = 1 - clavier.touche(vbKeyNumlock)
Call SetKeyboardState(clavier)
End Sub

A chaque appel de la macro, le statut de la touche numlock passe de 0 à 1 ou réciproquement, le pavé numérique est ainsi activé ou désactivé.

On peut évidemment activer d'autres touches par cette technique (Capslock, Scrolllock).
Chaque touche du clavier est codée de plusieurs manières :
on aurait pu remplacer clavier.touche(vbKeyNumlock) par clavier.touche(&H90) ou clavier.touche(144).
Cliquez ici pour voir la liste des codes de touches.

En VBA, on peut également utiliser SendKeys "{NUMLOCK}", mais le résultat n'est pas toujours probant.

Voir aussi SendInput
Autres techniques pour verrouiller la touche NumLock : cliquez ici.

Verrouiller (ou déverrouiller) la touche de majuscules (SendInput de user32 et copymemory de kernel32)

La fonction SendInput de la dll user32 (ne marche pas avec Windows 95) permet de simuler des actions sur la souris ou le clavier qui lui sont communiquées sous forme de tableau de type INPUT, tableau qui contient une liste d'évenements de type KEYBDINPUT ou MOUSEINPUT.

Declare Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As INPUT_TYPE, ByVal cbSize As Long) As Long
Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Type KEYBDINPUT
      wVk As Integer
      dwFlags As Long
End Type
Type INPUT_TYPE
      dwType As Long
      xi(0 To 23) As Byte
End Type

Sub frappe_caplock()
Dim evenements(0 To 1) As INPUT_TYPE
Dim clavier_event As KEYBDINPUT
clavier_event.wVk = 20

clavier_event.dwFlags = 0
evenements(0).dwType = 1
CopyMemory evenements(0).xi(0), clavier_event, Len(clavier_event)

clavier_event.dwFlags = 2
evenements(1).dwType = 1
CopyMemory evenements(1).xi(0), clavier_event, Len(clavier_event)

Call SendInput(2, evenements(0), Len(evenements(0)))
End Sub

La ligne clavier_event.wVk = 20 indique le code de la touche à actionner, 20 représentant capslock.
On aurait aussi bien pu choisir une autre touche, voir la liste des codes des touches du clavier.
clavier_event.dwFlags = 0 indique que l'on souhaite presser sur la touche, clavier_event.dwFlags = 2 que l'on relache la touche.
Le dwType de evenements(num) indique le type d'évenement souhaité pour l'évenement n° num, 1 pour un évenement clavier.
La fonction CopyMemory est utilisée pour insérer successivement les différents évenements dans le tableau d'évenements soumis à SendInput.

La commande VBA SendKeys ("{capslock}") peut être utilisée mais est parfois capricieuse.

Voir aussi SetKeyboardState

Afficher le titre de la fenêtre active

La fonction GetWindowText de la dll user32 retourne le nom de la fenêtre visée. La fonction GetActiveWindow de la dll user32 retourne le pointeur de la fenêtre active.

Declare Function get_titre Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetActiveWindow Lib "user32" () As Long

Sub nom_de_la_fenetre()
Dim nom_fenetre As String
nom_fenetre = String(200, Chr$(0))
Call get_titre(GetActiveWindow(), nom_fenetre, 201)
nom_fenetre = Left$(nom_fenetre, InStr(nom_fenetre, Chr$(0)) - 1)
MsgBox nom_fenetre
End Sub

GetActiveWindow() renvoie le pointeur de la fenêtre active.
Ce pointeur est utilisé par la fonction GetWindowTextA (renommée ici get_titre) qui va placer le titre dans la variable nom_fenetre (buffer de 200 caractères).
On peut utiliser GetFocus() au lieu de GetActiveWindow() pour trouver le nom de la fenêtre qui a le focus (en général le nom du classeur seul.

En VBA, on peut utiliser MsgBox ActiveWindow.Caption , qui renvoie le titre du fichier en cours ou bien Msgbox Application.Caption qui renvoie le titre de la fenêtre principale de l'application Excel.

Fermer une application à partir du titre de sa fenêtre (FindWindowA et PostMessageA de user32)

Declare Function cherche_fenetre Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Sub ferme_fenetre()
nom_fenetre = "Navigation en cours - (C:)"
PostMessage cherche_fenetre(vbNullString, nom_fenetre), 16, 0, 0
End Sub

La fonction "FindWindowA" (renommée ici cherche_fenetre) renvoie le pointeur de la fenetre dont le titre lui a été transmis en argument.
Attention, il faut inscrire le titre exact de le fenêtre, "Navigation en cours - (C:)" dans notre exemple (explorateur windows).
PostMessage, avec 16 comme argument wMsg (message WM_CLOSE), ferme la fenêtre.

Couvrir l'écran (barres d'outils comprises) de hachures (LineTo de gdi32 et GetWindowDC de user32)

Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long

Sub traits()
fen = GetWindowDC(0)
LineTo fen, 0, 0
For num = 0 To 80
LineTo fen, 10 * num - 1500, 1500
LineTo fen, 10 * num, 0
LineTo fen, 10 * (num + 1), 0
Next
End Sub

La fonction GetWindowDC récupère le pointeur de la fenetre, englobant les barres d'outils et de menus.
LineTo trace un trait vers le point dont les coordonnées sont spécifiées.

Inscrire dans une page Excel la liste de tous les processus en cours (FindWindowA, GetWindowTextA et GetWindow de user32)

Declare Function cherche_fenetre Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
Declare Function get_titre Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Dim titre As String

Sub tous_les_processus()
Columns(1).ClearContents
lin = 0
poign = cherche_fenetre(0, 0)
Do While poign <> 0
titre = String(100, Chr$(0))
get_titre poign, titre, 100
titre = Left$(titre, InStr(titre, Chr$(0)) - 1)
If titre <> "" Then
lin = lin + 1
Cells(lin, 1).Value = titre
End If
poign = GetWindow(poign, 2)
Loop
End Sub

La fonction GetWindow avec un paramètre wCmd fixé à 2 (GW_HWNDNEXT) permet de parcourir les pointeurs de toutes les fenetres, en partant de la première dont le pointeur est trouvé par cherche_fenetre(0, 0) où cherche_fenetre est le nom donné ici à la fonction Find_WindowA.
Le titre des fenêtres est retourné à partir du pointeur par la fonction GetWindowTextA.

On peut aussi utiliser la fonction EnumChildWindows qui permet d'établir la liste de toutes les fenêtres filles d'une fenêtre donnée.

Cliquez ici pour une macro plus élaborée (recherche de toutes les fenêtres et sous-fenêtres avec indication du type de fenêtre).

>>> voir les exemples suivants >>>>

- Les API
- Les correspondances entre macros VBA, macros Excel 4, fonctions de feuilles de calcul et API.