FAQ Visual Basic

FAQ Visual Basic Consultez toutes les FAQ

Nombre d'auteurs : 50, nombre de questions : 300, dernière mise à jour : 15 juin 2021

Sommaire→Système

Version PDF Version hors-ligne

Comment déterminer l'identifiant et la langue du système d'exploitation ?

La liste complète des identifiants de langage est disponible à l'adresse suivante : MSDN : Language Identifiers and Locales

Placez ce code dans la section déclaration de votre form ou dans un module :

Sélectionnez

Private Declare Function GetSystemDefaultLangID Lib "kernel32" () As Long
Private Declare Function VerLanguageName Lib "kernel32" Alias "VerLanguageNameA" _
(ByVal wLang As Long, ByVal szLang As String, ByVal nSize As Long) As Long
 
Private Enum pLang
    LangID = 1
    LangName = 2
End Enum
 
 
Private Function GetSystemLanguage(param As pLang) As String
    Dim ID As String
    Dim Buffer As String
    ID = "&H" & Right(Hex(GetSystemDefaultLangID()), 3)
    Select Case param
    Case 1
        GetSystemLanguage = ID & " / " & CStr(Val(ID))
    Case 2
        Buffer = String(255, 0)
        VerLanguageName CLng(ID), Buffer, Len(Buffer)
        Buffer = Left$(Buffer, InStr(1, Buffer, Chr$(0)) - 1)
        GetSystemLanguage = Buffer
    End Select
End Function

Exemple :

Sélectionnez

    MsgBox "L'ID langue est : " & GetSystemLanguage(LangID)
    MsgBox "Votre système est en : " & GetSystemLanguage(LangName)

Créé le 2 mai 2006 par mdriesbach , ThierryAIM

Comment savoir si mon clavier est en majuscule ou pas?

Sélectionnez

Public Declare Function GetKeyState Lib "user32" (ByVal iVirtualKey As Integer) As Long
 
Public Function Is_Majuscule() As Boolean
Is_Majuscule = (&H1 And GetKeyState(vbKeyCapital)) <> 0
End Function

La fonction Is_Majuscule renvoie true si le clavier est en majuscule, false sinon.

Mis à jour le 22 décembre 2008 par Tofalu

Lien : Comment Activer/Désactiver le Caps Lock du clavier

Comment Activer/Désactiver le Caps Lock du clavier

Sélectionnez

Private Type KeyboardBytes
     kbByte(0 To 255) As Byte
End Type
Enum apiOnOff
    apiOn = 1
    apiOff = 0
End Enum
Dim kbArray As KeyboardBytes
 
Private Declare Function GetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
Private Declare Function SetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
 
Private Sub ChangerCapsLock(v As apiOnOff)
    GetKeyboardState kbArray
    kbArray.kbByte(&H14) = v
    SetKeyboardState kbArray
End Sub

Utiliser sous la forme pour désactiver :

Sélectionnez

    ChangerCapsLock apiOff

ou, pour activer :

Sélectionnez

    ChangerCapsLock apiOn

Mis à jour le 22 décembre 2008 par Maxence HUBICHE

Comment déterminer les variables d'environnement du système (Windows 2000 et +) ?

A partir de Windows 2000, vous pouvez retrouver facilement les variables d'environnement du système à l'aide de l'astuce suivante :
(retourne dans la fenêtre d'exécution, toutes les variables d'environnement avec leur nom et leur valeur)

Sélectionnez

    Dim i As Integer
    For i = 1 To 255
        If Environ(i) <> "" Then Debug.Print Environ(i)
    Next

Dans un projet, vous pouvez utiliser, par exemple, le nom de la variable d'environnement dans votre code pour en extraire sa valeur :

Sélectionnez

    MsgBox Environ("USERNAME")

Créé le 2 mai 2006 par DarkVader

Comment exécuter des commandes Dos ?

Sélectionnez

'le paramètre /c indique que la console Dos doit se fermer sitôt l'exécution de la commande terminée.
Shell "command.com /c dir *.* > c:\liste.txt"

Créé le 29 juillet 2002 par Romain Puyfoulhoux

Comment exécuter un programme ?

Utilisez la fonction Shell. Vous pouvez indiquer dans le deuxième paramètre comment la fenêtre du programme doit s'afficher (si elle doit rester invisible, ou s'afficher normalement, ou en prenant tout l'écran, etc...).

Sélectionnez

Dim ret As Long
ret = Shell("notepad.exe", vbNormalFocus)

Créé le 29 juillet 2002 par Romain Puyfoulhoux

Lien : Comment ouvrir un fichier HTML, Word ou autre en utilisant l'exécutable associé ?

Comment fermer un programme ouvert avec la fonction Shell ?

Vous trouverez une méthode possible dans le code source ci-dessous. La procédure KillApp() ferme le programme dont l'identifiant est passé en paramètre. Vous pouvez utiliser la valeur renvoyée par la fonction Shell().

La seule ligne contenue dans la procédure KillApp() a pour effet d'énumérer toutes les fenêtres ouvertes, et d'appeler pour chacune d'entre-elles la fonction CloseWindow().
La fonction CloseWindow() regarde si la fenêtre en cours appartient au processus que l'on doit fermer, et si elle contient un menu Système (menu qui apparaît quand on clique sur l'icône de la fenêtre). Si c'est le cas, elle ferme la fenêtre.

Insérez ce code dans un module standard:

Sélectionnez

Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, _
   lpdwprocessid As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, _
   ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, _
   ByVal nIndex As Long) As Long
Private Const WM_CLOSE = &H10
Private Const GWL_STYLE = (-16)
Private Const WS_SYSMENU = &H80000
 
Private Function CloseWindow(ByVal hwnd As Long, ByVal hInstance As Long) As Long
 
Dim idproc As Long
 
idproc = 0
 
'reçoit dans idproc l'id du processus lié à cette fenêtre
GetWindowThreadProcessId hwnd, idproc
If (idproc = hInstance) And ((GetWindowLong(hwnd, GWL_STYLE) And WS_SYSMENU) = WS_SYSMENU) Then
     PostMessage hwnd, WM_CLOSE, 0, 0
End If
 
'obligatoire pour qu'EnumWindows continue l'énumération
CloseWindow = True
 
End Function
 
Public Sub KillApp(hInstance As Long)
 
EnumWindows AddressOf CloseWindow, hInstance
 
End Sub

Certains programmes n'acceptent pas d'être ouverts plusieurs fois en même temps. Pour cela, ils commencent par chercher si une instance du programme est déjà en mémoire. Si c'est le cas, ils terminent l'instance qui vient d'être créée, et si une nouvelle fenêtre doit être ouverte, c'est l'ancienne instance qui le fait.

Avec ce code source vous ne pourrez donc pas, par exemple, fermer une fenêtre de l'explorateur Windows ouverte par Shell(), car le processus dont l'id vous est renvoyé est automatiquement fermé, et la nouvelle fenêtre est ouverte par l'instance qui était déjà en mémoire.

Créé le 6 janvier 2003 par Romain Puyfoulhoux

Lien : Comment tuer un processus en connaissant le nom de sa fenêtre ?

Comment lister les processus actifs sans utiliser l'API Windows (Win2000 et >) ?

Il est possible de lister les processus actifs sur une machine en utilisant les fonctions de l'API Windows
Mais il existe une astuce beaucoup plus simple à l'aide d'un petit script WMI, utilisant la classe Win32_process (testé sur Windows 2000, XP)

Sélectionnez

Private Sub Command1_Click()
    Dim svc As Object
    Dim sQuery As String
    Dim oproc
    On Error GoTo Command1_Click_Error
 
    Set svc = GetObject("winmgmts:root\cimv2")
    sQuery = "select * from win32_process"
    For Each oproc In svc.execquery(sQuery)
        Debug.Print oproc.Name & " = " & oproc.ExecutablePath
    Next
    Set svc = Nothing
    Exit Sub
 
Command1_Click_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
    Err.Clear
End Sub

Retrouvez toutes les informations sur la classe Win32_process (propriétés et méthodes) sur le site de Microsoft MSDN : Win32_Process WMI class
Attention, certaines propriétés ne sont pas implémentées. Lire attentivement les descriptions et explications fournies sur le site !

Créé le 2 mai 2006 par ThierryAIM

Lien : Comment "tuer" un processus en mémoire (Win2000 et >)?
Lien : Microsoft MSDN : WMI Scripting Primer: Part 1

Comment "tuer" un processus en mémoire (Win2000 et >)?

En complément de la question précédente, il est possible d'arrêter un processus par le code, en le détruisant directement dans la liste des processus actifs de Windows

Sélectionnez

Public Function KillProcess(ByVal ProcessName As String) As Boolean
    Dim svc As Object
    Dim sQuery As String
    Dim oproc
    Set svc = GetObject("winmgmts:root\cimv2")
    sQuery = "select * from win32_process where name='" & ProcessName & "'"
    For Each oproc In svc.execquery(sQuery)
        oproc.Terminate
    Next
    Set svc = Nothing
End Function

Exemple pour Acrobat Reader :

Sélectionnez

    KillProcess "AcroRd32.exe"

Créé le 2 mai 2006 par ThierryAIM

Lien : Comment lister les processus actifs sans utiliser l'API Windows (Win2000 et >) ?
Lien : Microsoft MSDN : WMI Scripting Primer: Part 1

Comment verrouiller la station de travail ?

Il faut utiliser l'API Windows et plus particulièrement la fonction LockStation
Dans un module :

Sélectionnez

Private Declare Function LockWorkStation Lib "user32.dll" () As Long 
Public Sub Verrouiller() 
	LockWorkStation 
End Sub

Il suffit alors d'appeler la méthode Verrouiller là où vous en avez besoin.

Créé le 14 mai 2006 par Tofalu

Comment arrêter ou bien redémarrer le système ?

Pour cela, il faut utiliser l'API ExitWindowsEx.
Dans un module placer les déclarations suivantes :

Sélectionnez

Public Const EWX_LOGOFF = 0 
Public Const EWX_SHUTDOWN = 1 
Public Const EWX_REBOOT = 2 
Public Const EWX_FORCE = 4 
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long)

La constante LOGOFF ferme la session, SHUTDOWN arrête la machine, REBOOT redémarre. La constante FORCE peut être utiliser en addition d'une des 3 autres afin de forcer l'arrêt des applications sans demande de confirmation de sortie.
Exemple pour arrêter l'ordinateur :

Sélectionnez

ExitWindowsEx(EWX_SHUTDOWN, 0)

La même chose en forçant l'arrêt des applications :

Sélectionnez

ExitWindowsEx(EWX_SHUTDOWN OR EWX_FORCE, 0)

Mis à jour le 22 décembre 2008 par Tofalu

Comment réduire la fenêtre d'une application ?

Pour réduire une fenêtre d'une application , il faut passer par des API

ces déclarations sont à mettre au début du module :

Sélectionnez

' Déclarations
Const WM_SYSCOMMAND As Long = &H112
 
Const SC_MINIMIZE As Long = &HF020&
Const SC_MAXIMIZE As Long = &HF030&
Const SC_RESTORE As Long = &HF120&
 
Private Declare Function PostMessage Lib "User32.dll" Alias "PostMessageA" ( _
ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
Private Declare Function FindWindow1 Lib "User32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As Long, ByVal lpWindowName As String) As Long

Il faut utiliser la fonction suivante pour fermer la fenêtre, celle-ci fonctionne
avec le titre de la fenêtre à réduire :

Sélectionnez

Function AppMinimize(AppTitle As String) As Boolean
Dim hwnd As Long
hwnd = FindWindow1(0, AppTitle & vbNullChar)
If hwnd <> 0 Then
PostMessage hwnd, WM_SYSCOMMAND, SC_MINIMIZE, 0
AppMinimize = True
Else
AppMinimize = False ' Fenêtre pas trouvée
End If
End Function

Pour comprendre le fonctionnement vous pouvez faire un essai avec le Bloc-notes, ouvrez Bloc-notes, la fenêtre s'appelle : "Sans titre - Bloc-Notes".

mettez ce code sur un événement de votre choix :

Sélectionnez

Sub quicktest()
Dim AppTitle As String, tmr As Long
 
AppTitle = "Sans titre - Bloc-Notes"
AppActivate AppTitle
tmr = Timer
While ((Timer - tmr) < 2)
Wend
AppMinimize AppTitle
 
End Sub

Ouvrez votre Application en pleine fenêtre et la fenêtre Bloc-notes
en niveau inférieur, sur appel du code ci-dessus la fenêtre Bloc-notes se réduira après timer écoulé.

Mis à jour le 22 décembre 2008 par LedZeppII

Comment lister et modifier les services de Windows 2000 /XP ?

Dans le même esprit que les questions précédentes, il est possible, par un script WMI, de lister et d'intervenir sur les services Windows, à l'aide des propriétés et méthodes de la classe Win32_Service :

Exemple pour lister tous les services actifs et leur état (activé ou stoppé) :

Sélectionnez

    Dim svc As Object
    Dim sQuery As String
    Dim oserv
    On Error GoTo Command1_Click_Error
 
    Set svc = GetObject("winmgmts:root\cimv2")
    sQuery = "select * from win32_service"
    For Each oserv In svc.execquery(sQuery)
        Debug.Print oserv.Name & " : " & oserv.PathName & " : " & oserv.State
    Next
    Set svc = Nothing
    Exit Sub
 
Command1_Click_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
    Err.Clear

Retrouvez toutes les informations sur la classe Win32_Service (propriétés et méthodes) sur le site de Microsoft MSDN : Win32_Service WMI class

Créé le 2 mai 2006 par ThierryAIM

Lien : Comment lister les processus actifs sans utiliser l'API Windows (Win2000 et >) ?
Lien : Microsoft MSDN : WMI Scripting Primer: Part 1

Comment obtenir le numéro de série unique du processeur machine (Windows 2000 et >) ?

Toujours à l'aide d'un script WMI utilisant la classe Win32_processor :

Sélectionnez

Private Sub Command1_Click()
    Dim svc As Object
    Dim oproc
    On Error GoTo Command1_Click_Error
 
    Set svc = GetObject("winmgmts:root\cimv2")
    For Each oproc In svc.execquery("select * from Win32_Processor ")
        Debug.Print oproc.Name & " = " & oproc.ProcessorId
    Next
    Set svc = Nothing
    Exit Sub
 
Command1_Click_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
    Err.Clear
End Sub

Retrouvez toutes les informations sur la classe Win32_processor (propriétés et méthodes) sur le site de Microsoft MSDN : Win32_Processor WMI class

Créé le 2 mai 2006 par ThierryAIM

Lien : Microsoft MSDN : WMI Scripting Primer: Part 1

Comment tuer un processus en connaissant le nom de sa fenêtre ?

Le code suivant est assez similaire à celui de la question précédente, la différence résidant dans le fait que vous ne connaissez pas l'identifiant du processus mais juste le titre de la fenêtre.

Ce code doit être placé dans un module standard. Le principe utilisé est celui d'une énumération à l'aide d'un callback classique : la fonction EnumWindows énumère toutes les fenêtres ouvertes et appelle la fonction EnumCallback pour chacune d'entre elles. Celle-ci ferme la fenêtre si son titre contient l'expression recherchée.

Sélectionnez

Declare Function EnumWindows Lib "user32" (ByVal wndenmprc As Long, ByVal lParam As Long) As Long 
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, _
                                                                    ByVal lpString As String, _
                                                                    ByVal cch 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
Public Const WM_CLOSE = &H10
 
Private AppCible As String
 
Public Function EnumCallback(ByVal app_hWnd As Long, ByVal param As Long) As Long
 
Dim buf As String * 256
Dim Titre As String
Dim Longueur As Long
 
'Récupère le titre de la fenêtre
Longueur = GetWindowText(app_hWnd, buf, Len(buf))
Titre = Left$(buf, Longueur)
 
'Vérifie si le titre de la fenêtre correspond au nom recherché
If InStr(Titre, AppCible) <> 0 Then
    'Ferme la fenêtre
    SendMessage app_hWnd, WM_CLOSE, 0, 0
End If
 
'Poursuit l'énumération
EnumCallback = 1
 
End Function 
 
Public Sub KillApp(App_Cherchee As String)
 
AppCible = App_Cherchee
'Demande à Windows d'énumérer les fenêtres ouvertes
EnumWindows AddressOf EnumCallback, 0
 
End Sub

Un appel du type KillApp "Excel" fermera Microsoft Excel. Attention d'éviter l'utilisation de termes trop simples pouvant se trouver dans le titre d'une fenêtre d'une autre application.

Créé le 4 septembre 2003 par Jean-Marc Rabilloud

Lien : Comment fermer un programme ouvert avec la fonction Shell ?

Comment lire / écrire dans un fichier .ini ?

Les fichiers .ini sont des fichiers texte utilisés pour enregistrer les options d'un programme. Ils sont composés de sections, qui contiennent des clés auxquelles on peut donner une valeur. Par exemple :

Sélectionnez

[Affichage]
State=Maximized
Left=50
Top=80
[Sauvegarde]
Confirm=True
Auto=False

Pour pouvoir respectivement lire et écrire dans un fichier .ini, voici les déclarations que vous devez ajouter dans votre module :

Sélectionnez

Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _
    (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, _
    ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
 
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" _
    (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, _
    ByVal lpFileName As String) As Long

Voici ci-dessous la fonction qui écrira une valeur pour la clé et dans la section indiquée. Notez que vous n'avez pas besoin de créer le fichier s'il n'existe pas, car la fonction WritePrivateProfileString le fait pour vous.

Sélectionnez

Private Function EcritDansFichierIni(Section As String, Cle As String, _
                                     Valeur As String, Fichier As String) As Long
EcritDansFichierIni = WritePrivateProfileString(Section, Cle, Valeur, Fichier)
End Function

Et voyons maintenant la fonction qui nous retournera la valeur d'une clé dans une section donnée. ValeurParDefaut contient la valeur qui devra nous être retournée si le fichier n'existe pas, ou si aucune valeur n'a été spécifiée pour la clé demandée :

Sélectionnez

Private Function LitDansFichierIni(Section As String, Cle As String, Fichier As String, _
    Optional ValeurParDefaut As String = "") As String
 
Dim strReturn As String
strReturn = String(255, 0)
GetPrivateProfileString Section, Cle, ValeurParDefaut, strReturn, Len(strReturn), Fichier
LitDansFichierIni = Left(strReturn, InStr(strReturn, Chr(0)) - 1)
 
End Function

Le code nécessaire pour écrire la section [Affichage] du fichier donné en exemple sera :

Sélectionnez

EcritDansFichierIni "Affichage", "State", "Maximized", "c:\config.ini"
EcritDansFichierIni "Affichage", "Left", "50", "c:\config.ini"
EcritDansFichierIni "Affichage", "Top", "80", "c:\config.ini"

Et nous pourrons lire la valeur donnée à la clef "Left" avec :

Sélectionnez

LeftParam = LitDansFichierIni("Affichage", "Left", "c:\config.ini", 100)

Créé le 29 juillet 2002 par Romain Puyfoulhoux

Lien : Comment lister toutes les sections d'un fichier .ini ?
Lien : Comment lister toutes les clés et valeurs d'une section d'un fichier .ini ?

Comment lister toutes les sections d'un fichier .ini ?

Déclaration :

Sélectionnez

Private Declare Function GetPrivateProfileSectionNames Lib "kernel32.dll" Alias "GetPrivateProfileSectionNamesA" _
(ByVal lpszReturnBuffer As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Paramètre lpszReturnBuffer : adresse d'un tampon qui va recevoir la ou les sections du fichier .ini.
Chaque nom de section est terminé par un caractère null (Chr(0)=vbNullChar), le dernier est suivi d'un second caractère null.

Sélectionnez

Private Function ListeSectionIni(ByVal Path As String, Section() As String)
    Dim strReturn As String
    strReturn = String(8192, 0)
 
    GetPrivateProfileSectionNames strReturn, Len(strReturn), Path
 
    Section = Split(Left(strReturn, InStr(1, strReturn, vbNullChar & vbNullChar) - 1), vbNullChar)
End Function
 
Private Sub Command1_Click()
    Dim Section() As String
 
    ListeSectionIni "C:\test.ini", Section '-- Paramètre Section passé ByRef
    For Index = LBound(Section) To UBound(Section)
        Debug.Print Section(Index)
    Next
End Sub

Créé le 2 mai 2006 par Catbull, ThierryAIM

Lien : Comment lire / écrire dans un fichier .ini ?
Lien : Comment lister toutes les clés et valeurs d'une section d'un fichier .ini ?

Comment lister toutes les clés et valeurs d'une section d'un fichier .ini ?

Déclaration :

Sélectionnez

Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" _
(ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Paramètre lpReturnedString : adresse d'un tampon qui va recevoir la ou les clés et valeurs de la section du fichier .ini.
Chaque clé est terminée par un caractère null (Chr(0)=vbNullChar), la dernière est suivi d'un second caractère null.

Sélectionnez

Public Function ListeSectionKey(ByVal Path As String, ByVal Section As String, Key() As String)
    Dim strReturn As String
    strReturn = String(8192, 0)
 
    GetPrivateProfileSection Section, strReturn, 8192, Path
 
    Key = Split(Left(strReturn, InStr(1, strReturn, vbNullChar & vbNullChar) - 1), vbNullChar)
End Function
 
Private Sub Command1_Click()
    Dim Key() As String
 
    ListeSectionKey "C:\test.ini", "SectionName1", Key '-- le paramètre Key est passé byRef
    For Index = LBound(Key) To UBound(Key)
        Debug.Print Key(Index)
    Next
End Sub

Créé le 2 mai 2006 par Catbull, ThierryAIM

Lien : Comment lister toutes les sections d'un fichier .ini ?
Lien : Comment lire / écrire dans un fichier .ini ?

Comment ouvrir un fichier HTML, Word ou autre en utilisant l'exécutable associé ?

Placez cette déclaration dans le module d'une form :

Sélectionnez

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

La ligne suivante affiche le site Developpez.com dans le navigateur par défaut, en fournissant le répertoire de votre application comme répertoire par défaut :

Sélectionnez

ShellExecute Me.hwnd, "open", "http://www.developpez.com", "", App.Path, 1

Créé le 29 juillet 2002 par Romain Puyfoulhoux

Lien : Comment exécuter un programme ?

Comment connaître la résolution de l'écran ?

Sélectionnez

Dim x As Long, y As Long
x = Screen.Width / Screen.TwipsPerPixelX    'résolution horizontale
y = Screen.Height / Screen.TwipsPerPixelY   'verticale

Créé le 29 juillet 2002 par Romain Puyfoulhoux

Comment changer la résolution de l'écran ?

Copiez ce code source dans un module. Vous pourrez alors changer la résolution par un simple appel à la procédure ResolutionEcran(). Pour passer par exemple à une résolution de 800 x 600 :

Sélectionnez

 ResolutionEcran 800, 600

Sélectionnez

Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" _
   (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
 
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" _
   (lpDevMode As Any, ByVal dwflags As Long) As Long
 
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
Private Const DM_WIDTH = &H80000
Private Const DM_HEIGHT = &H100000
 
Private Type DEVMODE
    dmDeviceName As String * CCHDEVICENAME
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
     dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integer
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName As String * CCHFORMNAME
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
End Type
 
Public Sub ResolutionEcran(sgWidth As Long, sgHeight As Long)
 
Dim blTMP As Boolean, lgTMP As Long, dmEcran As DEVMODE, res As Long
 
lgTMP = 0
Do
    blTMP = EnumDisplaySettings(0, lgTMP, dmEcran)
    lgTMP = lgTMP + 1
Loop While blTMP <> 0
 
dmEcran.dmFields = DM_WIDTH Or DM_HEIGHT
dmEcran.dmPelsWidth = sgWidth
dmEcran.dmPelsHeight = sgHeight
lgTMP = ChangeDisplaySettings(dmEcran, 0)
 
End Sub

Créé le 6 janvier 2003 par Romain Puyfoulhoux

Comment détecter le changement de la résolution de l'écran ?

Sous Windows, toutes les fenêtres des applications reçoivent le message WM_DISPLAYCHANGE quand la résolution a changé. Le principe consiste donc à intercepter ce message grâce au sousclassement.

Copiez ce code source dans le module de la form.

Sélectionnez

Private Sub Form_Load()
 
    'Remplace la procédure de fenêtre par défaut par notre propre procédure
    oldWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
 
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
 
    'Remet la procédure de fenêtre par défaut
    SetWindowLong hwnd, GWL_WNDPROC, oldWndProc
 
End Sub

Et celui-ci dans un module standard.

Sélectionnez

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
                                      (ByVal hwnd As Long, ByVal nIndex As Long, _
                                       ByVal dwNewLong As Long) As Long
Public Const GWL_WNDPROC = (-4)
Public oldWndProc As Long
 
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
                                        (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, _
                                         ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const WM_DISPLAYCHANGE = &H7E
 
Public Function WindowProc(ByVal hwnd As Long, ByVal msg As Long, _
                           ByVal wParam As Long, ByVal lParam As Long) As Long
 
    If msg = WM_DISPLAYCHANGE Then
        'la résolution a changé
    End If
 
    'Appelle la procédure de fenêtre par défaut pour que Windows puisse traiter l'évènement
    WindowProc = CallWindowProc(oldWndProc, hwnd, msg, wParam, lParam)
 
End Function

Attention, la procédure Form_Unload doit obligatoirement être exécutée. Si vous déboguez et cliquez sur Stop, l'éditeur VB plantera. Si vous fermez votre programme avec l'instruction End, la procédure Form_Unload ne sera pas exécutée et votre programme plantera.

Créé le 6 septembre 2004 par Romain Puyfoulhoux

Lien : Qu'est-ce que le sous classement ?

Comment énumérer les polices disponibles ?

Les polices disponibles à l'écran et à l'impression sont respectivement dans la collection Fonts de l'objet Screen et dans la collection Fonts de l'objet Printer. Le code source ci-dessous montre comment remplir une combo box avec les polices disponibles à l'écran.

Sélectionnez

Dim i As Long
 
For i = 0 To Screen.FontCount - 1
    Combo1.AddItem Screen.Fonts(i)
Next

Créé le 6 septembre 2004 par Romain Puyfoulhoux

Comment faire une pause pendant un temps défini ?

Placez cette ligne dans la partie Déclarations d'un module :

Sélectionnez

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Vous pourrez ainsi faire une pause de 2 secondes avec l'appel suivant :

Sélectionnez

Sleep 2000

Créé le 29 juillet 2002 par Romain Puyfoulhoux

Comment récupérer les paramètres régionaux, comme le séparateur décimal ou celui des milliers ?

Les paramètres régionaux s'obtiennent grâce à la fonction GetLocaleInfo() de l'API Windows. Les paramètres de cette fonction sont :

locale : identifiant représentant le type d'information locale demandé (système ou utilisateur)
LCType : valeur indiquant quel paramètre doit être retrouvé. Ce doit être une des constantes LCTYPE
lpLCData : buffer recevant la valeur du paramètre demandé
cchData : longueur du buffer

Voici les déclarations des deux fonctions dont vous aurez besoin, ainsi que quelques-unes des constantes LCTYPE disponibles :

Sélectionnez

Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal locale As Long, _
    ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
 
Private Declare Function GetUserDefaultLCID Lib "kernel32" () As Long
 
Private Const LOCALE_IDATE = &H21          'format de date courte : 0 = M-J-A, 1 = J-M-A, 2 = A-M-J
Private Const LOCALE_ILDATE = &H22         'format de date longue
Private Const LOCALE_SCOUNTRY = &H6        'pays en toutes lettres
Private Const LOCALE_SNATIVELANGNAME = &H4 'langue, en toutes lettres
Private Const LOCALE_STHOUSAND = &HF       'séparateur des milliers
Private Const LOCALE_SDECIMAL = &HE        'séparateur décimal

La fonction ci-dessous renvoie la valeur du paramètre régional dont la constante LCTYPE est passée en paramètre :

Sélectionnez

Private Function ParametreRegional(parametre As Long) As String
 
Dim lngResultat As Long
Dim buffer As String
Dim pos As Integer
Dim locale As Long
 
'récupère l'identifiant de l'information locale de type utilisateur
locale = GetUserDefaultLCID()
 
'renvoie le nombre de caractères nécessaire pour recevoir la valeur du paramètre demandé
lngResultat = GetLocaleInfo(locale, parametre, buffer, 0)
 
buffer = String(lngResultat, 0)
GetLocaleInfo locale, parametre, buffer, lngResultat
pos = InStr(buffer, Chr(0))
If pos > 0 Then ParametreRegional = Left(buffer, pos - 1)
End Function

Créé le 6 janvier 2003 par Romain Puyfoulhoux

Comment récupérer le chemin UNICODE d'un lecteur ?

Sélectionnez

Private Const RESOURCETYPE_ANY = &H0
Private Const RESOURCE_CONNECTED = &H1
Private Type NETRESOURCE
    dwScope As Long
    dwType As Long
    dwDisplayType As Long
    dwUsage As Long
    lpLocalName As Long
    lpRemoteName As Long
    lpComment As Long
    lpProvider As Long
End Type
Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, _
 ByVal dwUsage As Long, lpNetResource As Any, lphEnum As Long) As Long
Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, _
 lpBuffer As Any, lpBufferSize As Long) As Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Function LetterToUNC(DriveLetter As String) As String
    Dim hEnum As Long
    Dim NetInfo(1023) As NETRESOURCE
    Dim entries As Long
    Dim nStatus As Long
    Dim LocalName As String
    Dim UNCName As String
    Dim i As Long
    Dim r As Long
 
    ' Begin the enumeration
    nStatus = WNetOpenEnum(RESOURCE_CONNECTED, RESOURCETYPE_ANY, 0&, ByVal 0&, hEnum)
 
    LetterToUNC = DriveLetter
 
    'Check for success from open enum
    If ((nStatus = 0) And (hEnum <> 0)) Then
        ' Set number of entries
        entries = 1024
 
        ' Enumerate the resource
        nStatus = WNetEnumResource(hEnum, entries, NetInfo(0), CLng(Len(NetInfo(0))) * 1024)
 
        ' Check for success
        If nStatus = 0 Then
            For i = 0 To entries - 1
                ' Get the local name
                LocalName = ""
                If NetInfo(i).lpLocalName <> 0 Then
                    LocalName = Space(lstrlen(NetInfo(i).lpLocalName) + 1)
                    r = lstrcpy(LocalName, NetInfo(i).lpLocalName)
                End If
 
                ' Strip null character from end
                If Len(LocalName) <> 0 Then
                    LocalName = Left(LocalName, (Len(LocalName) - 1))
                End If
 
                If UCase$(LocalName) = UCase$(DriveLetter) Then
                    ' Get the remote name
                    UNCName = ""
                    If NetInfo(i).lpRemoteName <> 0 Then
                        UNCName = Space(lstrlen(NetInfo(i).lpRemoteName) + 1)
                        r = lstrcpy(UNCName, NetInfo(i).lpRemoteName)
                    End If
 
                    ' Strip null character from end
                    If Len(UNCName) <> 0 Then
                        UNCName = Left(UNCName, (Len(UNCName) - 1))
                    End If
 
                    ' Return the UNC path to drive
                    'added the [] to seperate on printout only
                    LetterToUNC = UNCName
 
                    ' Exit the loop
                    Exit For
                End If
            Next i
        End If
    End If
 
    ' End enumeration
    nStatus = WNetCloseEnum(hEnum)
End Function

Appelez la fonction directement comme ceci :

Sélectionnez

LetterToUNC("E:")

et elle renvoie :

\\hp-ux004\oracle

Mis à jour le 22 décembre 2008 par Gaël Donat

Comment récupérer les chemins complets des répertoires Windows, System, et Windows\Temp ?

Voici deux solutions possibles. Tout d'abord, les fonctions de l'API Windows :

Sélectionnez

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" _
    (ByVal lpBuffer As String, ByVal nSize As Long) As Long
 
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" _
    (ByVal lpBuffer As String, ByVal nSize As Long) As Long
 
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
    (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Ces 3 fonctions de l'API Win32 renvoient respectivement les chemins complets des répertoires Windows, System, et Windows\Temp. Elles s'utilisent toutes les 3 de la même manière :

Sélectionnez

Function GetWindowsDir() As String
 
Dim buffer As String * 256
Dim Length As Long
Length = GetWindowsDirectory(buffer, Len(buffer))
GetWindowsDir = Left(buffer, Length)
 
End Function
 
Function GetSystemDir() As String
 
Dim buffer As String * 256
Dim Length As Long
Length = GetSystemDirectory(buffer, Len(buffer))
GetSystemDir = Left(buffer, Length)
 
End Function
 
Function GetTempDir() As String
 
Dim buffer As String * 256
Dim Length As Long
Length = GetTempPath(Len(buffer), buffer)
GetTempDir = Left(buffer, Length)
 
End Function

Une autre manière de procéder est de faire appel au FileSystemObject :

Sélectionnez

Dim fso As FileSystemObject
 
Set fso = New FileSystemObject
 
MsgBox fso.GetSpecialFolder(0)   'répertoire windows
MsgBox fso.GetSpecialFolder(1)   'répertoire system
MsgBox fso.GetSpecialFolder(2)   'répertoire temp
 
Set fso = Nothing
 
End Sub

Créé le 6 janvier 2003 par Romain Puyfoulhoux

Comment obtenir les chemins complets des répertoires spéciaux ?

Pour récupérer les chemins complets des répertoires du Bureau, de Mes Documents, ou du menu Démarrer, vous pouvez utiliser la fonction SHGetSpecialFolderPath de l'Api Windows :

Sélectionnez

Private Declare Function SHGetSpecialFolderPath Lib "shell32.dll" Alias "SHGetSpecialFolderPathA" _
                                                (ByVal hwndOwner As Long, ByVal lpszPath As String, _
                                                 ByVal nFolder As Long, ByVal fCreate As Long) As Long

Description des paramètres :
hwndOwner : handle de la fenêtre à utiliser si une boîte de dialogue doit être affichée
lpszPath : chaîne de caractères recevant le chemin complet du répertoire demandé
nFolder : nombre indiquant le répertoire demandé
fCreate : si la valeur passée à ce paramètre n'est pas nulle, le répertoire est créé, s'il n'existe pas déjà

Sous Windows NT 4.0 et Windows 95, cette fonction n'est disponible que si Internet Explorer 4.0 ou supérieur est installé. Voyons comment l'utiliser :

Sélectionnez

Public Function GetSpecialFolderPath(dossier As Long, hwnd As Long)
 
Dim buffer As String
 
buffer = Space(256)
SHGetSpecialFolderPath hwnd, buffer, dossier, 0
GetSpecialFolderPath = Left(buffer, InStr(buffer, Chr(0)) - 1)
 
End Function

Pour tester cette fonction, placez par exemple ces 3 lignes dans une procédure du module d'une form :

Sélectionnez

MsgBox GetSpecialFolderPath(0, Me.hwnd)   'répertoire du Bureau
MsgBox GetSpecialFolderPath(5, Me.hwnd)   'répertoire Mes Documents
MsgBox GetSpecialFolderPath(11, Me.hwnd)  'répertoire du menu Démarrer

Les réfractaires aux Api Windows préfèreront utiliser le Windows Script Host Object Model en ajoutant wshom.ocx aux références du projet. Les chemins complets des répertoires spéciaux sont dans la collection SpecialFolders de l'objet WshShell.

Sélectionnez

Dim Wsh As WshShell
 
Set Wsh = New WshShell
 
MsgBox Wsh.SpecialFolders.Item("Desktop")      'répertoire du Bureau
MsgBox Wsh.SpecialFolders.Item("MyDocuments")  'répertoire Mes Documents
MsgBox Wsh.SpecialFolders.Item("StartMenu")    'répertoire du menu Démarrer
 
Set WshShell = nothing
 
End Sub

Nota : Avec les anciennes versions de Wshom.ocx, la classe WshShell s'appelle IWshShell_Class.

ou encore :

Sélectionnez

    Set WshShell = CreateObject("Wscript.Shell")
    MsgBox WshShell.SpecialFolders("Desktop")
    MsgBox WshShell.SpecialFolders("MyDocuments")
    MsgBox WshShell.SpecialFolders("StartMenu")
Set WshShell = nothing

Créé le 6 janvier 2003 par Romain Puyfoulhoux

Comment connaître la version de Windows sur laquelle mon application est exécutée ?

La fonction VersionWindows() de ce code source retourne la version de Windows et place dans le paramètre sp le service pack qui serait éventuellement installé.

Sélectionnez

Private Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
 
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2
 
Private Type OSVERSIONINFO
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion As String * 128
End Type
 
Public Function VersionWindows(ByRef sp As String) As String
 
    Dim os As OSVERSIONINFO
 
    os.dwOSVersionInfoSize = Len(os)
    GetVersionExA os
    sp = ""
 
    With os
        Select Case .dwPlatformId
            Case VER_PLATFORM_WIN32_WINDOWS
                Select Case .dwMinorVersion
                    Case 0
                        VersionWindows = "95"
                    Case 10
                        VersionWindows = "98"
                    Case 90
                        VersionWindows = "Me"
                End Select
            Case VER_PLATFORM_WIN32_NT
                Select Case .dwMajorVersion
                    Case 3
                        VersionWindows = "NT 3.51"
                    Case 4
                        VersionWindows = "NT 4.0"
                    Case 5
                        If .dwMinorVersion = 0 Then
                            VersionWindows = "2000"
                        Else
                            VersionWindows = "XP"
                        End If
                End Select
        End Select
 
        If InStr(.szCSDVersion, Chr(0)) > 0 Then
            sp = Left(.szCSDVersion, InStr(.szCSDVersion, Chr(0)) - 1)
        End If
    End With
 
End Function

Mis à jour le 22 décembre 2008 par Romain Puyfoulhoux

Lien : Comment savoir si mon application VB6 et exécutée sous Windows VISTA ?

Comment savoir si mon application VB6 et exécutée sous Windows VISTA ?

En utilisant la méthode décrite ici :
Comment connaître la version de Windows sur laquelle mon application est exécutée ?

Grâce à la fonction GetVersionExA, la variable de type OSVERSIONINFO, retourne pour sa propriété : dwMajorVersion = 6 lorsque le systéme d'exploitation et Vista où Windows Serveur 2008.

Pour obtenir plus d'informations il faut passer par la fonction "étendue" de GetVersion, et le type de donnée OSVERSIONINFOEX, dont la propriété wProductType prends la valeur 1 pour les systémes d'exploitation de type station de travail (Vista, XP , 2000)

Sélectionnez

Private Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFOEX) As Integer
 
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2
 
'wProductType
Private Const VER_NT_WORKSTATION = 1 'Windows Vista, Windows XP Professional, Windows XP Home Edition, or Windows 2000 Professional
Private Const VER_NT_DOMAIN_CONTROLLER = 2 'Controleur de domaine sous Windows Serveur 2008,2003 ou 2000
Private Const VER_NT_SERVER = 3 'Windows Serveur 2008 , 2003 or 2000
 
 
Private Type OSVERSIONINFOEX
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion As String * 128
   wServicePackMajor As Integer
   wServicePackMinor As Integer
   wSuiteMask As Integer
   wProductType As Byte
   wReserved As Byte
End Type
 
Public Function VersionWindows(ByRef sp As String) As String
 
    Dim os As OSVERSIONINFOEX
 
    os.dwOSVersionInfoSize = Len(os)
    GetVersionExA os
    sp = ""
 
    With os
        Select Case .dwPlatformId
            Case VER_PLATFORM_WIN32_WINDOWS
                Select Case .dwMinorVersion
                    Case 0
                        VersionWindows = "95"
                    Case 10
                        VersionWindows = "98"
                    Case 90
                        VersionWindows = "Me"
                End Select
            Case VER_PLATFORM_WIN32_NT
                Select Case .dwMajorVersion
                    Case 3
                        VersionWindows = "NT 3.51"
                    Case 4
                        VersionWindows = "NT 4.0"
                    Case 5
                        If .dwMinorVersion = 0 Then
                            VersionWindows = "2000"
                        Else
                            VersionWindows = "XP"
                        End If
                    Case 6
                        If .wProductType = VER_NT_WORKSTATION Then
                             VersionWindows = "Vista"
                        Else
                            VersionWindows = "Windows Server 2008"
                        End If
 
 
                End Select
        End Select
 
        If InStr(.szCSDVersion, Chr(0)) > 0 Then
            sp = Left(.szCSDVersion, InStr(.szCSDVersion, Chr(0)) - 1)
        End If
    End With
 
End Function

Créé le 22 décembre 2008 par bbil, ProgElecT

Lien : OSVERSIONINFOEX Structure

Comment créer un raccourci sur le Bureau ?

Ajoutez la référence Windows Script Host Object Model (wshom.ocx) à votre projet.

Sélectionnez

Dim Wsh As New WshShell
 
DesktopPath = Wsh.SpecialFolders("Desktop")
Set Shortcut = Wsh.CreateShortcut(DesktopPath & "\Test.lnk")
With Shortcut
    .TargetPath = App.EXEName
    .Description = "Mon Programme"
    .WindowStyle = 4
    .Save
End With

Avec les anciennes versions de Wshom.ocx, la classe WshShell s'appelle IWshShell_Class.

Créé le 17 février 2004 par Romain Puyfoulhoux

Comment récuperer le numéro de série d'un volume physique ?

Première possibilité, l'api GetVolumeInformation, dont voici la déclaration :

Sélectionnez

Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" _
    (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
    lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, _
    ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long

Cette fonction, qui permet d'obtenir diverses informations à propos d'un lecteur, s'utilise très simplement. Ces quelques lignes affichent le numéro de série du lecteur C :

Sélectionnez

Dim numero As Long
GetVolumeInformation "c:\", "", 0, numero, 0, 0, "", 0
MsgBox numero

Mais vous pouvez obtenir cette même information avec le FileSystemObject :

Sélectionnez

Dim fso As FileSystemObject
Set fso = New FileSystemObject
MsgBox fso.Drives("c").SerialNumber
Set fso = Nothing

Créé le 6 janvier 2003 par Romain Puyfoulhoux

Comment mettre mon programme à droite dans la barre des tâches (le systray) ?

Vous trouverez un exemple pas à pas avec le code source dans le Howto de MSDN.

Créé le 6 janvier 2003 par Romain Puyfoulhoux

Comment lancer un exécutable et reprendre la main quand il a fini ?

Copiez ce code dans un module standard :

Sélectionnez

Public Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" _
                                      (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, _
                                       ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
                                       ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
                                       ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
                                       lpStartupInfo As STARTUPINFO, _
                                       lpProcessInformation As PROCESS_INFORMATION) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
 
'Type pour gérer les lancements de processus
Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type
 
'Info sur un processus
Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessID As Long
    dwThreadID As Long
End Type
 
Public Const NORMAL_PRIORITY_CLASS = &H20&
Public Const STILL_ACTIVE = &H103&
 
Public Sub AttendreFinProcess(proc As PROCESS_INFORMATION, Optional timeout As Long = 60)
 
Dim Ret As Long
Dim tms As Single
Dim exitcode As Long
 
'Attendre la fin de la commande
tms = Timer
Ret = GetExitCodeProcess(proc.hProcess, exitcode)
Do While Ret <> 0 And exitcode = STILL_ACTIVE
    Ret = GetExitCodeProcess(proc.hProcess, exitcode)
    DoEvents
    Sleep 100
    If Timer - tms > timeout Then
        Err.Raise STILL_ACTIVE, "AttendreFinProcess", "Timeout sur l'attente de la fin d'un process"
    End If
Loop
If Ret = 0 Then
    Err.Raise Err.LastDllError, "AttendreFinProcess", "Erreur systeme N° " & Err.LastDllError
End If
 
End Sub
 
Public Sub LancerProcess(sExe As String, proc As PROCESS_INFORMATION)
 
Dim start As STARTUPINFO
Dim Ret As Long
 
'StartupInfo pour le processus qui lancera la commande
start.cb = Len(start)
'Lancement de la commande
Ret& = CreateProcess(0&, sExe, 0&, 0&, 0&, NORMAL_PRIORITY_CLASS, 0&, 0, start, proc)
If Ret = 0 Then
    Err.Raise Err.LastDllError, "LancerProcess", "Erreur systeme N° " & Err.LastDllError
End If
 
End Sub

Créez une form et placez-y un bouton nommé Command1. Puis copiez ce code dans le module de la form :

Sélectionnez

Private Sub Command1_Click()
 
Dim proc As PROCESS_INFORMATION
 
On Error GoTo errortag
proc.hProcess = -1
proc.hThread = -1
Debug.Print "Debut du processus"
Call LancerProcess("notepad", proc)
Call AttendreFinProcess(proc)
Debug.Print "fin du processus"
Call CloseHandle(proc.hProcess)
Call CloseHandle(proc.hThread)
 
Exit Sub
 
errortag:
If proc.hProcess <> -1 Then CloseHandle proc.hProcess
If proc.hThread <> -1 Then CloseHandle proc.hThread
MsgBox Err.Number & " - " & Err.Description
 
End Sub

La fonction AttendreFinProcess() attend la fin d'un processus tant que le temps indiqué par le paramètre timeout n'est pas écoulé.

Exécutez le projet et cliquez sur le bouton de commande. Le Notepad se lance. Lorsque vous le fermez, la console de débuggage affiche "fin du processus".

Créé le 17 février 2004 par Abelman

Comment obtenir le nom de l'utilisateur ?

Copiez cette déclaration au début d'un module standard :

Sélectionnez

Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
                                     (ByVal lpbuffer As String, nSize As Long) As Long

Copiez ensuite cette fonction dans votre module : (pour Win 98)

Sélectionnez

Private Function NomUtilisateur() As String
 
Dim sUserName As String
Dim iSize As Long
 
'Un premier appel pour avoir le nombre de caractères nécéssaire pour sUserName
GetUserName sUserName, iSize
 
'On met sUserName à la bonne taille
sUserName = Space(iSize)
 
'Appel final
GetUserName sUserName, iSize
NomUtilisateur = sUserName
 
 
End Function

PS : On aurait aussi pu déclarer sUsername avec une taille assez grande (dim sUserName as string*32). Un seul appel de GetUserName aurait alors suffit

Pour Windows 2000 et supérieur :

Sélectionnez

Dim NomUtilisateur As String
 
NomUtilisateur = Environ("USERNAME")

Mis à jour le 13 juin 2005 par Abelman, Romain Puyfoulhoux, hpj

Lien : Comment déterminer les variables d'environnement du système (Windows 2000 et +) ?

Comment Vérifier si l'utilisateur courant est Administrateur ?

Utilisez la fonction IsNTAdmin de l'API advpack.dll

Sélectionnez

Private Declare Function IsNTAdmin Lib "advpack.dll" (ByVal dwReserved As Long, ByRef lpdwReserved As Long) As Long
Public Sub VerifieSiAdmin()
    If CBool(IsNTAdmin(ByVal 0&, ByVal 0&)) = True Then
        MsgBox "Vous êtes Administrateur de ce poste"
    Else
        MsgBox "Vous n'êtes pas Administrateur de ce poste"
    End If
End Sub

Créé le 22 décembre 2008 par forum

Comment obtenir ou modifier le contenu du Presse-papiers ?

Vous pouvez accéder au presse-papiers via l'objet Clipboard.

Créé le 17 février 2004 par Romain Puyfoulhoux

Comment permettre à l'utilisateur de sélectionner une imprimante ?

Les imprimantes installées sont contenues dans la collection Printers. L'imprimante sélectionnée pour l'impression est représentée par l'objet Printer.

Nous allons voir deux méthodes différentes permettant à l'utilisateur de sélectionner une imprimante.

La première est très simple et s'appuie sur le Common Dialog Control. Cochez-le dans les composants du projet et placez-en un sur une form. Il suffit de cette instruction pour afficher la boîte de dialogue standard de propriétés d'impression :

Sélectionnez

CommonDialog1.ShowPrinter

La boîte de dialogue une fois validée, les propriétés de l'objet Printer sont automatiquement modifiées afin de correspondre aux paramètres saisis par l'utilisateur.

La deuxième méthode n'utilise aucun composant. Son principe consiste à affecter à l'objet Printer le nom d'une des imprimantes installées. Copiez ce code source dans un module standard.

Sélectionnez

Private Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" _
                                          (ByVal lpAppName As String, ByVal lpKeyName As String, _
                                          ByVal lpDefault As String, ByVal lpReturnedString As String, _
                                          ByVal nSize As Long) As Long
 
'Renvoie l'imprimante par défaut
 
Public Function ImprimanteParDefaut() As String
 
    Dim def As String, di As Long
 
    def = String(128, 0)
    di = GetProfileString("WINDOWS", "DEVICE", "", def, 127)
    If di Then ImprimanteParDefaut = Left$(def, di - 1)
 
End Function
 
'Sélectionne une imprimante
 
Public Function SelectionneImprimante(ByVal UneImprimante As String) As Boolean
 
    Dim impr As Printer, ok As Boolean
 
    'Il faut chercher dans la boucle l'imprimante correspondante
    'et l'affecter à Printer
 
    For Each impr In Printers
        If impr.DeviceName = UneImprimante Then
            Set Printer = impr
            ok = True
            Exit For
        End If
    Next
 
    SelectionneImprimante = ok
 
End Function

La fonction SelectionneImprimante sélectionne l'imprimante dont le nom est passé en paramètre. Maintenant placez un bouton de commande et une ComboBox sur une form et placez le code ci-dessous dans le module de la form.

Sélectionnez

Private Sub Form_Load()
 
    Dim ImpParDefaut As String, IdxImpParDefaut As Integer
    Dim impr As Printer, i As Long, pos As Integer
 
    'Récupère le nom de l'imprimante par défaut
    ImpParDefaut = ImprimanteParDefaut()
 
    'Enlève les informations qui suivent le nom de l'imprimante
    pos = InStr(1, ImpParDefaut, ",", vbTextCompare)
    If pos > 0 Then ImpParDefaut = Left(ImpParDefaut, pos - 1)
 
    'Ajoute dans la combo box les imprimantes
    IdxImpParDefaut = 0
    i = 0
    For Each impr In Printers
        Combo1.AddItem impr.DeviceName
        'Regarde si c'est celle par défaut et si oui retient son index
        If impr.DeviceName = ImpParDefaut Then IdxImpParDefaut = i
        i = i + 1
    Next
    'Sélectionne dans la combo l'imprimante par défaut
    If Combo1.ListCount > 0 Then Combo1.ListIndex = IdxImpParDefaut
 
End Sub
 
Private Sub Command1_Click()
 
    MsgBox "Avant : " & Printer.DeviceName
    SelectionneImprimante Combo1.Text
    MsgBox "Après : " & Printer.DeviceName
 
End Sub

La ComboBox contient la liste des imprimantes installées. Au chargement de la form, l'imprimante par défaut est sélectionnée dans la combo.

Créé le 6 septembre 2004 par Romain Puyfoulhoux, Alexandre Lokchine

Comment obtenir la quantité de mémoire du système ?

Pour obtenir tous les paramètres relatifs à la mémoire, placez ce code dans un module standard :

Sélectionnez

Public Type MEMORYSTATUS
    dwLength As Long
    dwMemoryLoad As Long
    dwTotalPhys As Long
    dwAvailPhys As Long
    dwTotalPageFile As Long
    dwAvailPageFile As Long
    dwTotalVirtual As Long
    dwAvailVirtual As Long
End Type
 
Public Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)

Voici comment utiliser la fonction GlobalMemoryStatus :

Sélectionnez

Dim MS As MEMORYSTATUS
Dim chaine As String
 
MS.dwLength = Len(MS)
GlobalMemoryStatus MS
 
chaine = "Pourcentage RAM utilisé: " & Format$(MS.dwMemoryLoad, "###,###,###,###") & "  %" & vbCrLf
'on divise toutes les valeurs par 1024 pour les convertir en Kilots-octets
chaine = chaine & "Taille de la mémoire physique totale: " & _
                      Format$(MS.dwTotalPhys / 1024, "###,###,###,###") & " Ko" & vbCrLf
chaine = chaine & "Mémoire physique disponible: " & _
                      Format$(MS.dwAvailPhys / 1024, "###,###,###,###") & "  Ko" & vbCrLf
chaine = chaine & "Mémoire virtuelle totale: " & _
                      Format$(MS.dwTotalVirtual / 1024, "###,###,###,###") & " Ko" & vbCrLf
chaine = chaine & "Mémoire virtuelle disponible: " & _
                      Format$(MS.dwAvailVirtual / 1024, "###,###,###,###") & " Ko" & vbCrLf

Créé le 28 juin 2004 par Alexandre Lokchine, Romain Puyfoulhoux

Comment éjecter le lecteur de cd-rom ?

Sélectionnez

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
                                       (ByVal lpstrCommand As String, ByVal lpstrReturnString As Any, _
                                       ByVal wReturnLength As Integer, ByVal hCallback As Integer) As Long
 
Public Sub Ejecte()
 
mciSendString "Set CDAudio Door Open Wait", 0&, 0, 0
 
End Sub

Créé le 6 septembre 2004 par Romain Puyfoulhoux

Comment afficher/masquer la barre des tâches ?

Ajouter ces déclarations dans un module :

Sélectionnez

Private Declare Function SetWindowPos Lib "user32" ( _ 
            ByVal hwnd As Long, _ 
            ByVal hWndInsertAfter As Long, _ 
            ByVal x As Long, _ 
            ByVal y As Long, _ 
            ByVal cx As Long, _ 
            ByVal cy As Long, _ 
            ByVal wFlags As Long) As Long 
 
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _ 
            ByVal lpClassName As String, _ 
            ByVal lpWindowName As String) As Long 
 
Private Const SWP_HIDEWINDOW As Long = &H80 
Private Const SWP_SHOWWINDOW As Long = &H40 
 
Public Sub masquer() 
    Dim hwnd As Long 
    hwnd = FindWindow("Shell_traywnd", "") 
    SetWindowPos hwnd, 0, 0, 0, 0, 0, SWP_HIDEWINDOW 
End Sub 
 
Public Sub afficher() 
    Dim hwnd As Long 
    hwnd = FindWindow("Shell_traywnd", "") 
    SetWindowPos hwnd, 0, 0, 0, 0, 0, SWP_SHOWWINDOW 
End Sub

Créé le 13 juin 2005 par ridan

Comment lancer un élément du panneau de configuration ?

Liste non exhaustive des éléments du panneau de configuration :

Administrateur de sources de données ODBC : Odbccp32.cpl
Ajout/Suppression de Programmes : Appwiz.cpl
Assistant Ajout de nouveau matériel : hdwwiz.cpl
Comptes d'utilisateurs : nusrmgr.cpl
Connexions Réseau : Ncpa.cpl
Contrôleurs de jeu : joy.cpl
Options D'accessibilité : Access.cpl
Options d'alimentation : Ups.cpl/powercfg.cpl
Options de modem et Téléphonie : Modem.cpl/Telephon.cpl
Options Régionales et Linguistiques : Intl.cpl
Propriétés d'affichage : Desk.cpl
Propriétés de Date et Heure : Timedate.cpl
Propriétés de la sourie : Main.cpl
Propriétés Internet : Inetcpl.cpl
Propriétés Son et Périphériques audio : Mmsys.cpl
Propriétés système : Sysdm.cpl

Sélectionnez

Dim NomEl As String 
NomEl = "Appwiz.cpl" 
Shell "rundll32.exe shell32.dll,Control_RunDLL " & NomEl

Créé le 13 juin 2005 par ridan

Comment vider la corbeille ?

Sélectionnez

Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinA" ( _ 
                ByVal hwnd As Long, _ 
                ByVal pszRootPath As String, _ 
                ByVal dwFlags As Long) As Long 
 
'Annuuler la boite de dialogue de confirmation 
Private Const SHERB_NOCONFIRMATION = &H1 
'Annuler la boire de dialogue de progression de suppression 
Private Const SHERB_NOPROGRESSUI = &H2 
'Annuler le son à la fin de la suppression 
Private Const SHERB_NOSOUND = &H4

Pour appeler l'API :

Sélectionnez

SHEmptyRecycleBin 0, vbNullString, SHERB_NOCONFIRMATION

Créé le 13 juin 2005 par ridan

Comment activer/désactiver l'économiseur d'écran ?

Déclarer les constantes comme suit :

Sélectionnez

Private Const SPI_SETSCREENSAVEACTIVE As Long = 17 
Private Const VRAI As Long = 1 
Private Const FAUX As Long = 0 
 
Private Declare Function SystemParametersInfo Lib "user32.dll" Alias "SystemParametersInfoA" ( _ 
     ByVal uAction As Long, _ 
     ByVal uParam As Long, _ 
     ByRef lpvParam As Any, _ 
     ByVal fuWinIni As Long) As Long

Pour activer l'économiseur :

Sélectionnez

SystemParametersInfo spi_screensaveactive, VRAI, 0, 0

Pour désactiver l'économiseur :

Sélectionnez

SystemParametersInfo spi_screensaveactive, FAUX, 0, 0

Créé le 13 juin 2005 par ridan

Comment afficher l'écran de veille où éteindre le moniteur

En utilisant l'API SendMessage.
Pour afficher l'écran de veille

Sélectionnez

Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" _
                                     (ByVal hWnd As Long, ByVal wMsg As Long, _
                                      ByVal wParam As Long, ByVal lParam As Long) As Long
 
 
Const WM_SYSCOMMAND = &H112&
Const SC_SCREENSAVE = &HF140&
Private Sub CdEcranVeille_Click()
    Dim lRes As Long
    lRes = SendMessage(Form1.hWnd, WM_SYSCOMMAND, _
        SC_SCREENSAVE, 0&)
End Sub

Pour éteindre l'écran :

Sélectionnez

'Pour les besoin de l'éxemple on utilise la fonction Sleep de l'API Kernel32
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
 
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" _
                                     (ByVal hWnd As Long, ByVal wMsg As Long, _
                                      ByVal wParam As Long, ByVal lParam As Long) As Long
 
Const WM_SYSCOMMAND = &H112&
Const SC_MONITORPOWER = &HF170&
 
Private Sub cdScreenPowerOff_Click()
    Dim lRes As Long
     Sleep (5000) 'Une pause de 5s
  ' Pour éteindre l'écran 
    lRes = SendMessage(Form1.hWnd, WM_SYSCOMMAND, _
        SC_MONITORPOWER, 2&)
     Sleep (5000) 'Une pause de 5s
  ' Pour afficher à nouveau l'écran.
	 lRes = SendMessage(Form1.hWnd, WM_SYSCOMMAND, _
        SC_MONITORPOWER, -1&)
    Debug.Print "Fin " & Now
End Sub

Créé le 22 décembre 2008 par bbil

Comment désactiver le gestionnaire des tâches ou la séquence de touches Ctrl-Alt-Suppr ?

Pour Windows 2000 et supérieur :
Cette astuce permet de désactiver ou d'activer le gestionnaire des tâches à partir du code de votre programme et donc, d'inhiber la séquence de touches Ctrl-Alt-Suppr.
Lorsque le gestionnaire est désactivé, le système renvoie un message d'avertissement (A utiliser avec précaution) :

Désactiver :

Sélectionnez

    Set WshShell = CreateObject("WScript.Shell")
    WshShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableTaskMgr", "1"
    Set WshShell = Nothing

Activer :

Sélectionnez

    Set WshShell = CreateObject("WScript.Shell")
    WshShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableTaskMgr", ""
    Set WshShell = Nothing

Créé le 2 mai 2006 par Khorne

Comment récupérer la taille et la position de la barre des tâches ?

Dans un module :

Sélectionnez

'déclaration du type Rect 
Private Type RECT 
        Left As Long 
        Top As Long 
        Right As Long 
        Bottom As Long 
End Type 
 
 
Public Type TaskBarInformation 
    Left As Long  'Position par rapport au bord gauche de l'écran 
    Top As Long   'Position par rapport au haut de l'écran 
    Width As Long 'Largeur 
    Height As Long 'Hauteur 
    Position As Long 'Position : 1 ->En Haut 
                     '           2 ->Droite 
                     '           3 ->Bas 
                     '           4 ->Gauche 
End Type 
 
Private Declare Function GetWindowRect Lib "user32" _ 
(ByVal hwnd As Long, lpRect As RECT) As Long 
 
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _ 
            ByVal lpClassName As String, _ 
            ByVal lpWindowName As String) As Long 
 
Public Function GetTaskBarInformation() As TaskBarInformation 
Dim rctTemp As RECT 
Dim tskTemp As TaskBarInformation 
Dim intI As Integer, intJ As Integer 
Dim hwnd As Long 
With Screen 
    intI = .Width \ (.TwipsPerPixelX * 2) 
    intJ = .Height \ (.TwipsPerPixelY * 2) 
End With 
'Récupère le handle de la barre des taches 
hwnd = FindWindow("Shell_traywnd", "") 
'Récupère le rectangle de la barre des taches 
GetWindowRect hwnd, rctTemp 
'Calcule les dimensions 
With tskTemp 
    .Left = rctTemp.Left 
    .Top = rctTemp.Top 
    .Width = rctTemp.Right - rctTemp.Left 
    .Height = rctTemp.Bottom - rctTemp.Top 
    If .Top > intJ Then 
        .Position = 3 
    ElseIf .Left > intI Then 
        .Position = 2 
    ElseIf .Top < intJ Then 
        .Position = 1 
    Else 
        .Position = 4 
    End If 
End With 
GetTaskBarInformation = tskTemp 
End Function

Exemple d'utilisation :

Sélectionnez

Dim TskTest As TaskBarInformation 
TskTest = GetTaskBarInformation 
With TskTest 
MsgBox "La position gauche est : " & .Left & vbCrLf & _ 
       "La position haute est : " & .Top & vbCrLf & _ 
       "La largeur est de : " & .Width & vbCrLf & _ 
       "La hauteur est de : " & .Height & vbCrLf & _ 
       "La position est : " & .Position 
End With

NB : Les dimensions sont données en pixels

Créé le 13 juin 2005 par Tofalu

Comment masquer le bouton démarrer avec VB ?

ce code vous permet de cacher et afficher le bouton démarrer, il suffit de placer 2 boutons sur ta form et ce code :

Sélectionnez

Private Declare Function ShowWindow Lib "user32" _
    (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
 
Private Declare Function FindWindow Lib "user32" _
    Alias "FindWindowA" (ByVal lpClassName As String, _
    ByVal lpWindowName As String) 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
 
Sub StartButton(blnValue As Boolean)
    Dim lngHandle As Long
    Dim lngStartButton As Long
 
    lngHandle = FindWindow("Shell_TrayWnd", "")
    lngStartButton = FindWindowEx(lngHandle, 0, "Button", vbNullString)
 
    If blnValue Then
        ShowWindow lngStartButton, 5
    Else
        ShowWindow lngStartButton, 0
    End If
End Sub
 
Private Sub Command1_Click()
StartButton (True)
End Sub
 
Private Sub Command2_Click()
StartButton (False)
End Sub

Créé le 22 décembre 2008 par nabil

Comment récupérer l'exécutable associé à un fichier ?

Si vous recherchez quel exécutable est associé à votre fichier, alors suivez le code ci-dessous :

vb/vba

Sélectionnez

Private Declare Function FindExecutableA Lib "shell32.dll" _
    (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
 
Public Const MAX_PATH = 256
 
Public Function FindExecutable(S As String) As String
    'trouve quel executable ouvre le fichier cible
    Dim i As Integer
    Dim S2 As String
 
    S2 = String(MAX_PATH, 32) & Chr$(0)
    i = FindExecutableA(S & Chr$(0), vbNullString, S2)
    If i > 32 Then
        FindExecutable = Left$(S2, InStr(S2, Chr$(0)) - 1)
    Else
        FindExecutable = ""
    End If
End Function

Créé le 3 octobre 2006 par SilkyRoad

Version PDF Version hors-ligne

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2013 Developpez Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.