Introduction

Astuces

' Comment
Dim sChaine As String
sChaine = "début" & " - " & "fin"

If Else

If x = y And x <> z Then
    command
Elseif Not x < 10 Or x >= 20
    command
Else
    command
End If

IIf / Immediate If

sMessgage = IIf(iValue = 10), "Ok", "Ko"

#If / Compiler Constants

#Const DEBUG = True

#If DEBUG Then

#End If

String

' Remplacer des caractères
nameLnk = Replace("ABC", "B", "6") ' A6C

Array

' déclaration avec des parenthèses
Dim MyArray() As Variant
' déclaration avec dimensionnement
Dim MyArray(1) As Variant

' redimensionnement (1 = index max = 2 éléments)
ReDim MyArray(1)
MyArray(0) = "Zéro"
MyArray(1) = "Un"

' redimensionner sans écraser le contenu existant
ReDim Preserve MyArray(2)
MyArray(2) = "Deux"

' afficher le contenu du tableau
Debug.Print Join(MyArray, ", ")

Fonctions / Sub routines

Sub MySub(
    ByRef Arg1 As String, 
    ByVal Arg2 As String,
    Optional Arg3 As String = "Arg3",  ' les arguments suivant doivent être eux aussi optionnels
    ParamArray Vals() As Variant)      ' doit être le dernier argument

End Sub

' lancement de MySub
' sans parenthèses
MySub Arg1, Arg2
' avec parenthèses
Call MySub(Arg1, Arg2)

' Les fonctions retourne un type
Function MyFunction() As String

End Function

ByRef les changements impactent l'argument appelant
ByVal une copie de la valeur est passée à la fonction, les changements restent donc locaux

Classe

Property

Private ms_Name As String

' pour un objet utiliser Set
Public Property Get Name() As String
    Name = ms_Name
End Property

' pour un objet utiliser ByRef et Set
Public Property Set Name(ByVal sName As String)
    ms_Name = sName
End Property

MessageBox / InputBox

MsgBox "Mon message!" & vbNewLine & "Bye!", vbOKOnly, "Titre"

Dim answer As Integer
answer = MsgBox("Question ?", vbYesNo + vbQuestion, "Titre")
If answer = vbYes Then
    ' ...
Else
    ' ...
End If

Dim myValue As Variant
myValue = InputBox("Texte", "Titre", "valeur par défaut")
' argument "valeur par défaut" est optionnel

Titre par défaut: Microsoft Excel

Le deuxième paramètre représente le type de boutons, le style de l'icône et quel est le bouton par défaut :

Type de bouton	0	vbOKOnly	OK button only
Type de bouton	1	vbOKCancel	OK and Cancel buttons
Type de bouton	2	vbAbortRetryIgnore	Abort, Retry, and Ignore buttons
Type de bouton	3	vbYesNoCancel	Yes, No, and Cancel buttons
Type de bouton	4	vbYesNo	Yes and No buttons
Type de bouton	5	vbRetryCancel	Retry and Cancel buttons
Icône	16	vbCritical	Critical Message icon
Icône	32	vbQuestion	Warning Query icon
Icône	48	vbExclamation	Warning Message icon
Icône	64	vbInformation	Information Message icon
Bouton par défaut	0	vbDefaultButton1	First button is default
Bouton par défaut	256	vbDefaultButton2	Second button is default
Bouton par défaut	512	vbDefaultButton3	Third button is default
Bouton par défaut	768	vbDefaultButton4	Fourth button is default
Modalité	0	vbApplicationModal	Application modal (the current application will not work until the user responds to the message box)
Modalité	4096	vbSystemModal	System modal (all applications wont work until the user responds to the message box)

Error handler

Sub MySub()
' définit le comportement en cas d'erreur
On Error GoTo PROC_ERR

PROC_EXIT:
    ' désactive la gestion d'erreurs
    On Error GoTo 0
    Exit Sub

PROC_ERR:
    MsgBox "error " & Err.Number & vbLf & Err.Description, vbCritical, "Error"
    ' ajouter un point d'arrêt, Step Over amène sur la ligne qui a posé problème
    Stop
    Resume
    ' ou simplement quitter la sub
    Resume PROC_EXIT

End Sub

Services Windows

Arrêt des services SQL

Option Explicit
Dim objWMIService, objService, strServiceList, colListOfServices

' Récupère l'objet Microsoft Management Console
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
' Sélectionne les services dont le nom contient SQL
Set colListOfServices = objWMIService.ExecQuery("Select * from Win32_Service Where Name like '%SQL%'")

' Arrête les services sélectionnés
strServiceList = "Liste des services arrêtés :" & vbCr
For Each objService in colListOfServices
	strServiceList = strServiceList & vbCr & objService.name
	objService.StopService()
	'objService.StartService()
Next

' Affiche la liste des services arrêtés
WScript.Echo strServiceList

Lire les entrées du clavier

valeur = InputBox("Saisissez une valeur :", "Titre", "Valeur par defaut")
MsgBox valeur

Créer un raccourci (fichier *.lnk)

Dim path, target
path = "C:\Destination\shortcut.lnk"
target = "C:\Program Files\ToDoList\ToDoList.exe"
targetDirectory = "C:\Program Files\ToDoList"

Set shell = WScript.CreateObject("WScript.Shell")
Set shortcut = shell.CreateShortCut(path)
shortcut.Targetpath = target
shortcut.WorkingDirectory = targetDirectory
shortcut.IconLocation = target
shortcut.Save

Scripting.FileSystemObject

Permet de manipuler les fichiers et les dossiers.

Méthodes	Description
DeleteFile(filepath[,force])	Supprime des fichiers.
DeleteFolder(folderpath[,force])	Supprime des répertoires
GetParentFolderName(path)	Renvoie le chemin du répertoire parent
GetFileName(filepath)	Renvoie le nom du fichier avec l'extension

Set fs = CreateObject("Scripting.FileSystemObject")

fs.DeleteFile("file_path"), True
fs.DeleteFolder("folder_path"), True

Lancer un programme

Dim objShell
Set objShell = WScript.CreateObject( "WScript.Shell" )
objShell.Run("""C:\Dossier\fichier.exe"" options")
Set objShell = Nothing

Ouvrir un fichier en écriture

Dim objFile As Variant
Dim strText As String

objFile = "C:\temp\Test.txt"
strText = "This text was written on " & Now & "."

Open objFile For Output As #1
Write #1, strText
Close #1

Utiliser une DLL

Dim objet As Classe
Set objet = New Classe
objet.Methode()

Explorateur de dossiers

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
            "SHGetPathFromIDListA" (ByVal pidl As Long, _
            ByVal pszPath As String) As Long
            
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
            "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
            As Long
            
Private Const BIF_RETURNONLYFSDIRS = &H1

Public Function BrowseFolder(szDialogTitle As String) As String
	Dim X As Long, bi As BROWSEINFO, dwIList As Long
	Dim szPath As String, wPos As Integer
  
    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    
    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
    
    If X Then
        wPos = InStr(szPath, Chr(0))
        BrowseFolder = Left$(szPath, wPos - 1)
    Else
        BrowseFolder = vbNullString
    End If
End Function

Convention de nommage

Notation hongroise

[scope] type [modifier] Name [Suffix]

type
i	int
n	short int
l	long int
f	float
d	double
c	char
by	byte
b	boolean
s	string
str	string object
o	object

modifier
u	unsigned
p	pointer
a ou ar	array
m_	member variable
g_	global variable
s_	static variable
l_	local variable

Exemples

DebugPrint

Affiche la source en plus du message.

Public Static Sub DebugPrint(ByVal Module As String, _
                             ByVal Procedure As String, _
                             ByVal Message As String, _
                    Optional ByVal Reset As Boolean)
' ==========================================================================
' Description : Provide enhanced printing to the Immediate window.
'
' Params      : Module      The name of the calling module.
'               Procedure   The name of the calling procedure.
'               Message     The message to display.
'               Reset       Force the static variables to be reset
' ==========================================================================

    Dim ssMod   As String
    Dim ssPrc   As String

    ' Only do this if there is something new to display
    ' -------------------------------------------------
    If ((Module <> ssMod) Or (Procedure <> ssPrc) Or Reset) Then

        ' Store the new values
        ' --------------------
        ssMod = Module
        ssPrc = Procedure

        ' Add a blank line
        ' ----------------
        Debug.Print

        ' Display the new source
        ' ----------------------
        If (Len(Trim(ssPrc)) > 0) Then
            Debug.Print "Src: " & Concat(".", ssMod, ssPrc)
        End If
    End If

    ' Display the message
    ' -------------------
    If (Len(Trim(Message)) > 0) Then
        Debug.Print "Msg: " & Message
    End If

End Sub

VBScript

Sommaire