VISUAL BASIC a donné naissance à deux sous languages facile d'accès permettant de générer dess scripts.
Le Visual Basic for Application : Pour Excel, Word et toute la suite office. Il peut être utilisé pour contrôler une application à partir d'une autre (par exemple, créer automatiquement un document Word à partir de données Excel).
Le Visual Basic Script : Pour windows2003, VBscript est un langage interprété. Il ne nécessite pas de compilation avant d'être exécuté. En revanche, il nécessite que la machine destinée à les exécuter possède un interpréteur, un programme capable de comprendre l'ensemble des instructions présentes dans le programme. Selon l'utilisation
Le Visual Basic for Application : Pour Excel, Word et toute la suite office. Il peut être utilisé pour contrôler une application à partir d'une autre (par exemple, créer automatiquement un document Word à partir de données Excel).
Le Visual Basic Script : Pour windows2003, VBscript est un langage interprété. Il ne nécessite pas de compilation avant d'être exécuté. En revanche, il nécessite que la machine destinée à les exécuter possède un interpréteur, un programme capable de comprendre l'ensemble des instructions présentes dans le programme. Selon l'utilisation
Did you know ? Un précis d'écriture de code est essentiel à la conception d'un script VBS ou VBA
Les différents "interpréteurs" du VBS sont:
- ASP (asp.dll) dans un environnement Web
- Wscript.exe dans un environnement Windows
- Cscript.exe dans un environnement à ligne de commande
Les extentions possibles sont :
- VBS: VBScript natifs.
- VBE: VBScript codé (non éditable).
- WSF : Peut contenir plusieurs languages en même temps (ex: VBS et JS).
- WSC : Fichier source Windows Script Components
LES CONSTANTES
Syntaxe : Const ExConstante = 0
Tableaux statiques de constantes
ListeJours = Array("Lundi","Mardi", .... ,"Vendredi","Samedi")
valeur minimale des index du tableau : LBound(ListeJours) = 0
valeur maximale des index du tableau : UBound(ListeJours) = 6
Exemples de constantes
bleufonce = 47: mauve=39: vert=35: jaune=19: orange=40: rouge0=22
rouge1=3: violet=39: bleu0=24: bleu1=17: bleu2=47
blanc=2: gris20=15: gris40=48: gris60=16: gris80=56: noir=1: rose=38: marron=53: vertfonce=14
LES VARIABLES
Syntaxe : Dim ExempleVariable as string
Portée des variables
- projet : Public Dim VarAPortéeGlobale as string
- module : Private Dim VarAPortéeModule as string
- fonction/procédure : Dim VarAPortéeLocale as string
Syntaxe : Const ExConstante = 0
Tableaux statiques de constantes
ListeJours = Array("Lundi","Mardi", .... ,"Vendredi","Samedi")
valeur minimale des index du tableau : LBound(ListeJours) = 0
valeur maximale des index du tableau : UBound(ListeJours) = 6
Exemples de constantes
bleufonce = 47: mauve=39: vert=35: jaune=19: orange=40: rouge0=22
rouge1=3: violet=39: bleu0=24: bleu1=17: bleu2=47
blanc=2: gris20=15: gris40=48: gris60=16: gris80=56: noir=1: rose=38: marron=53: vertfonce=14
LES VARIABLES
Syntaxe : Dim ExempleVariable as string
Portée des variables
- projet : Public Dim VarAPortéeGlobale as string
- module : Private Dim VarAPortéeModule as string
- fonction/procédure : Dim VarAPortéeLocale as string
LES TYPES
Définition d'un nouveau Type :
Type Texemple
Sheet As Sheets
Cat As String
Cell As Range
End Type
Utilisation du Type Texemple :
Dim Exemple as Texemple '(Exemple.Sheet, Exemple.Cat, Exemple.Cell)
Définition d'un nouveau Type :
Type Texemple
Sheet As Sheets
Cat As String
Cell As Range
End Type
Utilisation du Type Texemple :
Dim Exemple as Texemple '(Exemple.Sheet, Exemple.Cat, Exemple.Cell)
LES CHAINES DE CARACTERES
Transfo ASCII en caractères : Chr(34)
Transfo Caractère en code ASCII : Asc("A")
String(20,x) = "xxxxxxxxxxxxxxxxxxxx"
space(20) = " "
Len("toto") = 4
InStr("toto","o") = 2
Lcase("TOTO") = toto
UCase("toto") = TOTO
Left("Fabrice",3) = "fab"
Right("Fabrice",3) = "ice"
mid("Fabrice",5,2) = "ic"
monTab = split("c/de/fgt","/") (montab(0) = "c" , montab(1) = "de" , montab(2) = "fgt" )
Supprimer les espaces des extremitées d'une chaine de caractères : Trim(" toto ") = "toto"
Supprimer les espaces de l'extremitées droite d'une chaine de caractères : RTrim(" toto ") = " toto"
Supprimer les espaces de l'extremitées gauched'une chaine de caractères : LTrim(" toto ") = "toto "
remplacer les virgules par des points : strNew = Replace(strOld,",",".")
Transfo ASCII en caractères : Chr(34)
Transfo Caractère en code ASCII : Asc("A")
String(20,x) = "xxxxxxxxxxxxxxxxxxxx"
space(20) = " "
Len("toto") = 4
InStr("toto","o") = 2
Lcase("TOTO") = toto
UCase("toto") = TOTO
Left("Fabrice",3) = "fab"
Right("Fabrice",3) = "ice"
mid("Fabrice",5,2) = "ic"
monTab = split("c/de/fgt","/") (montab(0) = "c" , montab(1) = "de" , montab(2) = "fgt" )
Supprimer les espaces des extremitées d'une chaine de caractères : Trim(" toto ") = "toto"
Supprimer les espaces de l'extremitées droite d'une chaine de caractères : RTrim(" toto ") = " toto"
Supprimer les espaces de l'extremitées gauched'une chaine de caractères : LTrim(" toto ") = "toto "
remplacer les virgules par des points : strNew = Replace(strOld,",",".")
LES ROUTINES
Les routines du VBS sont de deux types : les fonctions qui sont des suites d'instructions retournant une valeur et les procédures qui sont elles aussi des suite d'instructions mais qui ne retournent pas de valeur.
Portées des routines:
Public : elle sera accessible à toutes les autres routines dans tous les autres modules de tous les projets actifs (défaut).
Private : si elle sera seulement accessible à d'autres procédures dans le même module.
Static : Les valeurs des variables déclarées dans cette Function sont préservées entre les appels VBA d'Excel.
Les procédures
Exemple de procédure
Sub ExempleProcédureInit(arg1 as integer ,arg2 as string, optional arg3 as string)
if ismissing(arg3) then action1 else action2
End Sub
Le test de présence d'une variable lors d'un appel à une procedure se fait avec l'instruction IsMissing.
Les fonctions
Exemple de fonction
Function exemple_de_fontion(arg1 as integer ,arg2 as string) as boolean
echo "coucou"
End FunctionPubkic
Les routines du VBS sont de deux types : les fonctions qui sont des suites d'instructions retournant une valeur et les procédures qui sont elles aussi des suite d'instructions mais qui ne retournent pas de valeur.
Portées des routines:
Public : elle sera accessible à toutes les autres routines dans tous les autres modules de tous les projets actifs (défaut).
Private : si elle sera seulement accessible à d'autres procédures dans le même module.
Static : Les valeurs des variables déclarées dans cette Function sont préservées entre les appels VBA d'Excel.
Les procédures
Exemple de procédure
Sub ExempleProcédureInit(arg1 as integer ,arg2 as string, optional arg3 as string)
if ismissing(arg3) then action1 else action2
End Sub
Le test de présence d'une variable lors d'un appel à une procedure se fait avec l'instruction IsMissing.
Les fonctions
Exemple de fonction
Function exemple_de_fontion(arg1 as integer ,arg2 as string) as boolean
echo "coucou"
End FunctionPubkic
LES TRIS
Trier des cellules :
range("D1:D6").Sort Key1:=Range(myrange), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,DataOption1:=xlSortNormal
Selection.Sort Key1:=Range(Cells(startline, Column_selected), Cells(Endline,Column_selected)),
Order1:=xlAscending, Key2:=Range(Cells(startline,ConsoCat_status.column), Cells(Endline, ConsoCat_status.column)),
Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
DataOption1:=xlSortTextAsNumbers, DataOption2:=xlSortNormal,
DataOption3:=xlSortNormal
Trier des cellules :
range("D1:D6").Sort Key1:=Range(myrange), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,DataOption1:=xlSortNormal
Selection.Sort Key1:=Range(Cells(startline, Column_selected), Cells(Endline,Column_selected)),
Order1:=xlAscending, Key2:=Range(Cells(startline,ConsoCat_status.column), Cells(Endline, ConsoCat_status.column)),
Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
DataOption1:=xlSortTextAsNumbers, DataOption2:=xlSortNormal,
DataOption3:=xlSortNormal
LES BOUCLES
Boucles FOR
for x = 10 to 0 Step -1 action Next
for each cellule in selected_range action Next
Boucles DO
x = 0 Do action loop Until test
Boucles While
x = 0 While test action Wend
Boucles FOR
for x = 10 to 0 Step -1 action Next
for each cellule in selected_range action Next
Boucles DO
x = 0 Do action loop Until test
Boucles While
x = 0 While test action Wend
LES FORMATS & DATES
Format(Date, "yy/mmmm/dd")
n ieme jour de l'année = Format(Date, "y")
Now , time, date
Nombre de millisecondes écoulées depuis le démarrage du système : GetTickCount
nb de secondes depuis minuit = timmer
Année = year(date)
n° du Mois = month(date)
nom du Mois = monthname(date)
Jour = day(date)
Heure = heure(time)
Heure sur 2 chiffres = Cstr(right("0"& heure(time),2))
Minute = minute(time)
Seconde = seconde(time)
num de série de la date du jour = aujourdhui()
num de série de la date et de l'heure = maintenant()
num de série du dern jr du mois = FIN.MOIS(Date_départ;Mois)
nb de jrs ouvrés entre 2 dates = NB.JOURS.OUVRES(Date1;Date1;liste_Jours_fériés)
jour de la semaine (de 1 à 7) = JOURSEM(Numéro_de_série;Type_retour)
Nombre de jours dans le mois = JOUR(DATE(ANNEE(D);MOIS(D)+1;0))
Conv : CBool(), CByte(), CCur(), CDate(), CDbl(), CDec(), CInt(), CLng(), Csng(), Cstr(), Cvar()
Format(Date, "yy/mmmm/dd")
n ieme jour de l'année = Format(Date, "y")
Now , time, date
Nombre de millisecondes écoulées depuis le démarrage du système : GetTickCount
nb de secondes depuis minuit = timmer
Année = year(date)
n° du Mois = month(date)
nom du Mois = monthname(date)
Jour = day(date)
Heure = heure(time)
Heure sur 2 chiffres = Cstr(right("0"& heure(time),2))
Minute = minute(time)
Seconde = seconde(time)
num de série de la date du jour = aujourdhui()
num de série de la date et de l'heure = maintenant()
num de série du dern jr du mois = FIN.MOIS(Date_départ;Mois)
nb de jrs ouvrés entre 2 dates = NB.JOURS.OUVRES(Date1;Date1;liste_Jours_fériés)
jour de la semaine (de 1 à 7) = JOURSEM(Numéro_de_série;Type_retour)
Nombre de jours dans le mois = JOUR(DATE(ANNEE(D);MOIS(D)+1;0))
Conv : CBool(), CByte(), CCur(), CDate(), CDbl(), CDec(), CInt(), CLng(), Csng(), Cstr(), Cvar()
LES STRUCTURES CONDITIONNELLES
Structures IF
Exemple 1
if test then
action
Elseif test2
action2
Else
action3
End if
Exemple 2
If test Then_
action1 Else action2
Exemple 3
If test Then action1
Exemple 4
Valeur = IIF(test;Valeur1;Valeur2)
Structures Select Case
Exemple 1
Select case valeur
case valeur1: action1
case valeur2: action2
End select
Structures IF
Exemple 1
if test then
action
Elseif test2
action2
Else
action3
End if
Exemple 2
If test Then_
action1 Else action2
Exemple 3
If test Then action1
Exemple 4
Valeur = IIF(test;Valeur1;Valeur2)
Structures Select Case
Exemple 1
Select case valeur
case valeur1: action1
case valeur2: action2
End select
LES COLLECTIONS
initialiser le catalogue : Dim oCatalogue : Set oCatalogue = CreateObject("Scripting.Dictionary")
Ajouter un élément : oCatalogue .add
initialiser le catalogue : Dim oCatalogue : Set oCatalogue = CreateObject("Scripting.Dictionary")
Ajouter un élément : oCatalogue .add
LES OBJETS
Set objExcel = CreateObject("Excel.Application")
Sheets("nom_de_la_feuille").Unprotect
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
For Each feuille In Worksheets --- --- Next
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=Sheet & "A1", TextToDisplay:=""
Sheets("#1").Unprotect
Sheets("#1").Copy After:=Sheets(Sheets.Count)
newsheetname = "#" & Sheets.Count - 2
Sheets("#1 (2)").name = newsheetname
Set objExcel = CreateObject("Excel.Application")
Sheets("nom_de_la_feuille").Unprotect
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
For Each feuille In Worksheets --- --- Next
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=Sheet & "A1", TextToDisplay:=""
Sheets("#1").Unprotect
Sheets("#1").Copy After:=Sheets(Sheets.Count)
newsheetname = "#" & Sheets.Count - 2
Sheets("#1 (2)").name = newsheetname
LES CELLULES
IsNumeric(), IsDate(), IsEmpty()
Cells(1,3) = range("a3") = [a3]
Couleur_de_la_police_de_caractère = cells(x,y).Font.ColorIndex
Couleur_de_fond = cells(x,y).Interior.ColorIndex
Gras : cells(x,y).Font.bold = True
Italic : cells(x,y).Font.italic = True
Nom de la police : cells(x,y).Font.name = Arial
Taille de la police : cells(x,y).Font.size = 12
Underline : cells(x,y).Font.underline = True
Style_de_ligne = cells(x,y).Borders(bordure).LineStyle { xlNone - xlContinuous })
Taille_bordure = cells(x,y).Borders(bordure).Weight { xlThin - xlMedium - xlThick})
Couleur_des_bordures = cells(x,y).Borders.ColorIndex
Couleur_de_bordure = cells(x,y).Borders(bordure).ColorIndex { xlInsideVertical - xlEdgeTop - xlEdgeBottom - xlEdgeLeft - xlEdgeRight
xlDiagonalDown - xlDiagonalUp }
Valeur_de_la_cellule = cells(x,y).value
Cellule_avant_chgt_de_cellule = Target
Numéro_de_ligne = Cells(x,y).row
Numéro_de_colonne = Cells(x,y).column
Supprimer la ligne de la case D3 : range("D3").Delete Shift:=xlUp ou range("D3").EntireRow.Delete
Ajouter une ligne : Rows("10:10").Insert Shift:=xlDown
Rechercher un cellule : Set FoundCell = range("D3:D7").Find(valtoseek, LookIn:=xlValues) : FoundLine = IIf (Cellule Is Nothing,0, FoundCell.row)
Fixer la taille de la ligne : Rows("10:10").RowHeight = 12.75
Selection.UnMerge
Set exemple_objet_cellule = Cells(x,y).offset(x,y)
Set sheet1 = Sheets("Feuille n°1")
Set sheet2 = Sheets(2)
Effacer le contenu des cellules : [A1:A10].ClearContents
Sélectionner plusieurs lignes : sheet.Rows("25:43,52:58").Select
Sélectionner plusieurs colonnes : sheet.Columns("A:B","D:H").Select
Première ligne de [A1:A10] : [A1:A10].CurrentRegion.Rows(1)
Dernière ligne de [A1:A10] : [A1:A10].CurrentRegion.Rows([A1:A10].CurrentRegion.Rows.Count)
Cellules vides de [A1:A10] : [A1:A10].SpecialCells(xlCellTypeBlanks)
Cellules num de [A1:A10] : [A1:A10].SpecialCells(xlCellTypeConstants, 1) { 1:num - 2:str - 3:str ou num }
Cells commentées de [A1:A10] : [A1:A10].SpecialCells(xlCellTypeComments)
Cellule non vide la plus à droite de [A1:A10] : [A1:A10].End(xlToRight) { xlDown - xlToRight - xlToLeft - xlUp }
Masquer des lignes : Range("A1").EntireRow.Hidden = True
Compter le nb de lignes dans une selection : Selection.rows.Count
Compter le nb de colonnes dans une selection : Selection.Columns.Count
IsNumeric(), IsDate(), IsEmpty()
Cells(1,3) = range("a3") = [a3]
Couleur_de_la_police_de_caractère = cells(x,y).Font.ColorIndex
Couleur_de_fond = cells(x,y).Interior.ColorIndex
Gras : cells(x,y).Font.bold = True
Italic : cells(x,y).Font.italic = True
Nom de la police : cells(x,y).Font.name = Arial
Taille de la police : cells(x,y).Font.size = 12
Underline : cells(x,y).Font.underline = True
Style_de_ligne = cells(x,y).Borders(bordure).LineStyle { xlNone - xlContinuous })
Taille_bordure = cells(x,y).Borders(bordure).Weight { xlThin - xlMedium - xlThick})
Couleur_des_bordures = cells(x,y).Borders.ColorIndex
Couleur_de_bordure = cells(x,y).Borders(bordure).ColorIndex { xlInsideVertical - xlEdgeTop - xlEdgeBottom - xlEdgeLeft - xlEdgeRight
xlDiagonalDown - xlDiagonalUp }
Valeur_de_la_cellule = cells(x,y).value
Cellule_avant_chgt_de_cellule = Target
Numéro_de_ligne = Cells(x,y).row
Numéro_de_colonne = Cells(x,y).column
Supprimer la ligne de la case D3 : range("D3").Delete Shift:=xlUp ou range("D3").EntireRow.Delete
Ajouter une ligne : Rows("10:10").Insert Shift:=xlDown
Rechercher un cellule : Set FoundCell = range("D3:D7").Find(valtoseek, LookIn:=xlValues) : FoundLine = IIf (Cellule Is Nothing,0, FoundCell.row)
Fixer la taille de la ligne : Rows("10:10").RowHeight = 12.75
Selection.UnMerge
Set exemple_objet_cellule = Cells(x,y).offset(x,y)
Set sheet1 = Sheets("Feuille n°1")
Set sheet2 = Sheets(2)
Effacer le contenu des cellules : [A1:A10].ClearContents
Sélectionner plusieurs lignes : sheet.Rows("25:43,52:58").Select
Sélectionner plusieurs colonnes : sheet.Columns("A:B","D:H").Select
Première ligne de [A1:A10] : [A1:A10].CurrentRegion.Rows(1)
Dernière ligne de [A1:A10] : [A1:A10].CurrentRegion.Rows([A1:A10].CurrentRegion.Rows.Count)
Cellules vides de [A1:A10] : [A1:A10].SpecialCells(xlCellTypeBlanks)
Cellules num de [A1:A10] : [A1:A10].SpecialCells(xlCellTypeConstants, 1) { 1:num - 2:str - 3:str ou num }
Cells commentées de [A1:A10] : [A1:A10].SpecialCells(xlCellTypeComments)
Cellule non vide la plus à droite de [A1:A10] : [A1:A10].End(xlToRight) { xlDown - xlToRight - xlToLeft - xlUp }
Masquer des lignes : Range("A1").EntireRow.Hidden = True
Compter le nb de lignes dans une selection : Selection.rows.Count
Compter le nb de colonnes dans une selection : Selection.Columns.Count
LES FICHIERS
Change l'attribut : SetAttr FichierUNC, attribut
Utilise le lecteur D comme lecteur courant = ChDrive "D"
Assigne le chemin courant à une variable a a = CurDir
crée un dossier dans le dossier courrant = MkDir "mon_dossier"
supprime un dossier vide dans le dossier courant = RmDir "mon_dossier"
Détruit tous les fichiers .doc du dossier courant = Kill "*.doc"
Utilise "c:\temp" comme nouveau dossier courant = ChDir "c:\temp"
Dim oShellApp As Object: Set oShellApp = CreateObject("Shell.Application")
'Decompresser tous le fichier searchedFile.txt du zip : toto.zip
oShellApp.Namespace("c:\FoundFile").CopyHere oShellApp.Namespace("c:\toto\toto.zip").Items.Item("searchedFile.txt")
'Decompresser tous les fichier du zip : toto.zip
oShellApp.Namespace("c:\FoundFile").CopyHere oShellApp.Namespace("c:\toto\toto.zip").Items
Ouvrir un fichier (en lect seul) : open "Fichier.txt" For Input As #1 {fichier n° 1)
Le lire Do While Not EoF(1) : Line Input #1, Textline : Msgbox textline : loop
Fermer ce fichier : Close #1
Ouvrir un fichier (ecriture) : open "Fichier.txt" For output As #1 {fichier n° 1)
ecrire dedans : liste = 0 : Do While liste < liste =" Liste">
Active une fenetre : Windows(nom_du_fichier).Activate
Sauvegarde un wkbook : ActiveWorkbook.SaveAs Filename:=nom_UNC_du_Fichier, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Fermeture d'une fenetre : ActiveWindow.Close
Quitter sans enregistrer: Private Sub Workbook_BeforeClose(Cancel As Boolean) ActiveWorkbook.Close savechanges:=False End Sub
Fermeture du classeur : wbExcel.Close
Fermeture de l'app Excel: appExcel.Quit
Désallocation mémoire : Set wsExcel = Nothing
Ouverture d'une feuille excel XLS ou csv
(les fichiers CSV sont des fichiers textes où une ligne du fichier correspond à une ligne de la feuille et les colonnes sont séparées par des ';') ,45, 4,10,23
Dim appExcel As Excel.Application 'Définition de l'Application Excel
Dim wbExcel As Excel.Workbook 'Définition du Classeur Excel
Dim wsExcel As Excel.Worksheet 'Définition de la Feuille Excel
Set appExcel = CreateObject("Excel.Application") 'Ouverture de l'application
Set wbExcel = appExcel.Workbooks.Open(nom_UNC_du_fichier) 'Ouverture d'un fichier Excel
Set wsExcel = wbExcel.Worksheets(1) 'wsExcel correspond à la première feuille du fichier
Spécificité d'un fichier texte avec comme séparateur le ';' commençant à la deuxième ligne et au format Windows(ANSI)
Dim appExcel As Excel.Application 'Définition de l'Application Excel
Dim wbExcel As Excel.Workbook 'Définition du Classeur Excel
Dim wsExcel As Excel.Worksheet 'Définition de la Feuille Excel
Set appExcel = CreateObject("Excel.Application")'Ouverture de l'application
Workbooks.OpenText Filename:= nom_UNC_du_fichier, Origin:=xlWindows, StartRow:=2, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote,ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True 'Ouverture d'un fichier Excel
Set wbExcel=appExcel.ActiveWorkbook
Set wsExcel=wbExcel.ActiveSheet
Change l'attribut : SetAttr FichierUNC, attribut
Utilise le lecteur D comme lecteur courant = ChDrive "D"
Assigne le chemin courant à une variable a a = CurDir
crée un dossier dans le dossier courrant = MkDir "mon_dossier"
supprime un dossier vide dans le dossier courant = RmDir "mon_dossier"
Détruit tous les fichiers .doc du dossier courant = Kill "*.doc"
Utilise "c:\temp" comme nouveau dossier courant = ChDir "c:\temp"
Dim oShellApp As Object: Set oShellApp = CreateObject("Shell.Application")
'Decompresser tous le fichier searchedFile.txt du zip : toto.zip
oShellApp.Namespace("c:\FoundFile").CopyHere oShellApp.Namespace("c:\toto\toto.zip").Items.Item("searchedFile.txt")
'Decompresser tous les fichier du zip : toto.zip
oShellApp.Namespace("c:\FoundFile").CopyHere oShellApp.Namespace("c:\toto\toto.zip").Items
Ouvrir un fichier (en lect seul) : open "Fichier.txt" For Input As #1 {fichier n° 1)
Le lire Do While Not EoF(1) : Line Input #1, Textline : Msgbox textline : loop
Fermer ce fichier : Close #1
Ouvrir un fichier (ecriture) : open "Fichier.txt" For output As #1 {fichier n° 1)
ecrire dedans : liste = 0 : Do While liste < liste =" Liste">
Active une fenetre : Windows(nom_du_fichier).Activate
Sauvegarde un wkbook : ActiveWorkbook.SaveAs Filename:=nom_UNC_du_Fichier, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Fermeture d'une fenetre : ActiveWindow.Close
Quitter sans enregistrer: Private Sub Workbook_BeforeClose(Cancel As Boolean) ActiveWorkbook.Close savechanges:=False End Sub
Fermeture du classeur : wbExcel.Close
Fermeture de l'app Excel: appExcel.Quit
Désallocation mémoire : Set wsExcel = Nothing
Ouverture d'une feuille excel XLS ou csv
(les fichiers CSV sont des fichiers textes où une ligne du fichier correspond à une ligne de la feuille et les colonnes sont séparées par des ';') ,45, 4,10,23
Dim appExcel As Excel.Application 'Définition de l'Application Excel
Dim wbExcel As Excel.Workbook 'Définition du Classeur Excel
Dim wsExcel As Excel.Worksheet 'Définition de la Feuille Excel
Set appExcel = CreateObject("Excel.Application") 'Ouverture de l'application
Set wbExcel = appExcel.Workbooks.Open(nom_UNC_du_fichier) 'Ouverture d'un fichier Excel
Set wsExcel = wbExcel.Worksheets(1) 'wsExcel correspond à la première feuille du fichier
Spécificité d'un fichier texte avec comme séparateur le ';' commençant à la deuxième ligne et au format Windows(ANSI)
Dim appExcel As Excel.Application 'Définition de l'Application Excel
Dim wbExcel As Excel.Workbook 'Définition du Classeur Excel
Dim wsExcel As Excel.Worksheet 'Définition de la Feuille Excel
Set appExcel = CreateObject("Excel.Application")'Ouverture de l'application
Workbooks.OpenText Filename:= nom_UNC_du_fichier, Origin:=xlWindows, StartRow:=2, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote,ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True 'Ouverture d'un fichier Excel
Set wbExcel=appExcel.ActiveWorkbook
Set wsExcel=wbExcel.ActiveSheet
LES NOMBRES
retourne la val absolue : Abs(-9) = 9
retourne le signe : Sgn(-9) = -1 {-1 0 1 }
arrondi a l'entier inférieur : Int(13,9) = 13 et Int(-13,1) = -14
Partie entière : Fix(13,9) = 13 et Fix(-13,1) = -13
nb aléat entre [0 - 1[ : Randomize pour initialiser puis Rdn
Modulo : 32 Mod 10 = 2
Puissance : 2^3 = 8
racine carré : SQR(4) = 2
Division complète : 10/3 = 3,33333
Division entière : 10\3 = 3
retourne la val absolue : Abs(-9) = 9
retourne le signe : Sgn(-9) = -1 {-1 0 1 }
arrondi a l'entier inférieur : Int(13,9) = 13 et Int(-13,1) = -14
Partie entière : Fix(13,9) = 13 et Fix(-13,1) = -13
nb aléat entre [0 - 1[ : Randomize pour initialiser puis Rdn
Modulo : 32 Mod 10 = 2
Puissance : 2^3 = 8
racine carré : SQR(4) = 2
Division complète : 10/3 = 3,33333
Division entière : 10\3 = 3
LES TABLES DE VERITE
IMPRESSION
Sheets(1).PageSetup.LeftFooter = "&Bcommentaire_de_gauche&B"
Sheets(1).PageSetup.CenterFooter = "&8Page &amp;amp;amp;amp;amp;amp;_
amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;_
amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;_
amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;P & of &N"
Sheets(1).PageSetup.RightFooter = "&8Last Saved : &B" & ActiveWorkbook.BuiltinDocumentProperties("Last save time")
ActiveSheet.PageSetup.PrintArea = "$B$2:$AH$9"
ActiveSheet.PrintOut Copies:=1, Collate:=True
Range("A1:D4").PrintOut
Sheets(1).PageSetup.LeftFooter = "&Bcommentaire_de_gauche&B"
Sheets(1).PageSetup.CenterFooter = "&8Page &amp;amp;amp;amp;amp;amp;_
amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;_
amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;_
amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;P & of &N"
Sheets(1).PageSetup.RightFooter = "&8Last Saved : &B" & ActiveWorkbook.BuiltinDocumentProperties("Last save time")
ActiveSheet.PageSetup.PrintArea = "$B$2:$AH$9"
ActiveSheet.PrintOut Copies:=1, Collate:=True
Range("A1:D4").PrintOut
LA BARRE DE STATUS
Application.DisplayStatusBar = True
Application.StatusBar = "Message à positionner dans la barre de status"
Application.DisplayStatusBar = True
Application.StatusBar = "Message à positionner dans la barre de status"
LES BOITES DE DIALOGUES
MSGBOX
La fonction MsgBox affiche un message dans une boîte de dialogue, attend que l'utilisateur clique sur un bouton, puis renvoie un entier indiquant le bouton choisi par l'utilisateur.
reponse = MsgBox(prompt[,Options][,title][,helpfile, context])
reponse = MsgBox("Question à poser", vbYesNo + vbCritical + vbDefaultButton, "Titreboite")
Avec option = Type boutons + Style Icône + Bouton par défaut + Modalité de la boite de dialogue
INPUTBOX
La fonction InputBox affiche une invite dans une boîte de dialogue, attend que l'utilisateur tape du texte ou clique sur un bouton, puis renvoie le contenu de la zone de texte sous la forme d'une chaîne de caractère.
reponse = InputBox(prompt[,title][,default][,xpos][,ypos] [,helpfile,context])
MSGBOX
La fonction MsgBox affiche un message dans une boîte de dialogue, attend que l'utilisateur clique sur un bouton, puis renvoie un entier indiquant le bouton choisi par l'utilisateur.
reponse = MsgBox(prompt[,Options][,title][,helpfile, context])
reponse = MsgBox("Question à poser", vbYesNo + vbCritical + vbDefaultButton, "Titreboite")
Avec option = Type boutons + Style Icône + Bouton par défaut + Modalité de la boite de dialogue
INPUTBOX
La fonction InputBox affiche une invite dans une boîte de dialogue, attend que l'utilisateur tape du texte ou clique sur un bouton, puis renvoie le contenu de la zone de texte sous la forme d'une chaîne de caractère.
reponse = InputBox(prompt[,title][,default][,xpos][,ypos] [,helpfile,context])
valeurs de la variable Type boutons
valeurs de la variable Style Icône
valeurs de la variable Bouton par défaut
valeurs de la variable Modale
valeurs possible de la réponse de la msgbox
LES USERFORMS
PréCharger un UserForm : Load UserForm1
Afficher un UserForm : UserForm1.Show
Cacher un UserForm : UserForm1.Hide
Décharger un UserForm : Unload UserForm1
CheckBoxes
Assigner un état clické à une checkBox : Sheets(1).CheckBox1.Value = true
TextBox
remplir un champ : UserForm1.champ1 = "FR"
Mettre le focus sur un champ : UserForm1.TextBox13.SetFocus
Mettre le focus sur un Bouton : UserForm1.CommandButton1.SetFocus
Ordre de Tabulation
Afin de respecter un ordre de tabulation ("Enter" ou "Tab")
PréCharger un UserForm : Load UserForm1
Afficher un UserForm : UserForm1.Show
Cacher un UserForm : UserForm1.Hide
Décharger un UserForm : Unload UserForm1
CheckBoxes
Assigner un état clické à une checkBox : Sheets(1).CheckBox1.Value = true
TextBox
remplir un champ : UserForm1.champ1 = "FR"
Mettre le focus sur un champ : UserForm1.TextBox13.SetFocus
Mettre le focus sur un Bouton : UserForm1.CommandButton1.SetFocus
Ordre de Tabulation
Afin de respecter un ordre de tabulation ("Enter" ou "Tab")
LES EVENEMENTS
OnKey
Lancer la fonction Launchprg lors d'un appui sur la touche "1" :
application.onkey "1","launchprg"
Ne fais rien lors d'un appui sur la touche "1" : application.onkey "1",""
Rends sa fonction d'origine à la touche "1" : application.onkey "1"
OnKey
Lancer la fonction Launchprg lors d'un appui sur la touche "1" :
application.onkey "1","launchprg"
Ne fais rien lors d'un appui sur la touche "1" : application.onkey "1",""
Rends sa fonction d'origine à la touche "1" : application.onkey "1"
GESTION DES ERREURS
saute la ligne en cas d'erreur : On Error Resume Next
va à la ligne "finprg:" en cas d'erreur :
On error Goto finprg
xxx xxx
xxx xxx
finprg:
arrete la détéction d'erreur : On Error GoTo 0
L’instruction Exit permet de quitter un bloc Do...Loop : Exit Do
L’instruction Exit permet de quitter un bloc For...Next : Exit For
L’instruction Exit permet de quitter une Function : Exit function
L’instruction Exit permet de quitter un Sub : Exit sub
BOITE A OUTILS
Cette boite à outil contient un ensemble de fonctions complètes, prêtes à l'emploi
Recopie des cellules d'un workbook excel non ouvert
Utilisation : GetDataFromClosedWorkbook nom_fichier_UNC, "F31:F32", "A1", False )
Function GetDataFromClosedWorkbook(SourceFile As String, SourceRange As String, TargetRange As range, IncludeFieldNames As Boolean) 'Requires a reference to the Microsoft ActiveX Data Objects library
Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset, dbConnectionString As String
Dim TargetCell As range, i As Integer
dbConnectionString = "DRIVER={Microsoft Excel Driver (*.xls)};" & "ReadOnly=1;DBQ=" & SourceFile
Set dbConnection = New ADODB.Connection
On Error GoTo InvalidInput
dbConnection.Open dbConnectionString ' open the database connection
Set rs = dbConnection.Execute("[" & SourceRange & "]")
Set TargetCell = TargetRange.Cells(1, 1)
TargetCell.CopyFromRecordset rs
rs.Close
dbConnection.Close ' close the database connection
Set TargetCell = Nothing
Set rs = Nothing
Set dbConnection = Nothing
GetDataFromClosedWorkbook = True
On Error GoTo 0
Exit Function
InvalidInput:
GetDataFromClosedWorkbook = False
End Function
Décompresse un fichier existant (ou non) dans l'un des fichiers zip d'un repertoire
Sub Unzip(FileSearched, ZipFolder, UnzipFolder)
Dim oShellApp As Object: Set oShellApp = CreateObject("Shell.Application")
Dim oFSO1: Set oFSO1 = CreateObject("Scripting.FileSystemObject")
Dim oZipFolder As Object: Set oZipFolder = oFSO1.GetFolder(ZipFolder)
Dim oFSO2: Set oFSO2 = CreateObject("Scripting.FileSystemObject")
Dim ZipFile As Variant
Dim oZipFile As Object
Dim oFileInZipFolder As Object
Dim message
If (oZipFolder.Files.Count > 0) Then
For Each oZipFile In oZipFolder.Files
ZipFile = oZipFile.Name
If (InStr(1, ZipFile, ".zip", 1) > 0) Then
For Each oFileInZipFolder In oShellApp.Namespace(ZipFolder & ZipFile).Items
If oFileInZipFolder.Name = FileSearched Then
If oFSO1.FileExists(UnzipFolder & FileSearched) Then oFSO1.DeleteFile (UnzipFolder & FileSearched)
oShellApp.Namespace(UnzipFolder).CopyHere _
oShellApp.Namespace(ZipFolder & ZipFile).Items.Item(FileSearched)
End If
Next
End If
Next
End If
Set oShellApp = Nothing: Set oFSO2 = Nothing: Set oZipFolder = Nothing: Set oZipFile = Nothing: Set oFSO1 = Nothing
End Sub
Retourne "true" si un fichier existe
Private Function FileExist(File As String) As Boolean
Dim L As Long
On Error GoTo FExErr
L = FileLen(File)
FileExist = True
Exit Function
FExErr: FileExist = False
Exit Function
End Function
Retourne "true" si un fichier existe
Private Function FileExist(FileUNC As String) As Boolean
FileExist = IIf (Dir(fileUNC) = fileUNC,True, False)
End Function
Importe un fichier CSV dans une feuille Excel
Sub importCSVfile(file)
Sheets("Transfert").Range("A1:BB500").ClearContents
With Sheets("Transfert").QueryTables.Add(Connection:="TEXT;C:\Report.csv", Destination:=Sheets("Transfert").Range("A1"))
.Name = "Report"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 4, 4, 4, 4, 4, 2)
.Refresh BackgroundQuery:=False
End With
Sheets("Transfert").Range("N1").FormulaR1C1 = "User"
End Sub
renvoie les valeurs d'une plage de cellules (srcRange)
d'une feuille (srcSheet) d'un fichier (srcFile) ferme
dans un tableau (outArr) le paramètre TTL indique si
la plage a ou non une ligne d'entêtes
Utilisation : GetExternalData nomduFichier, sourceSheetname, sourcerange, False, Arr
Sub GetExternalData(srcFile As String, srcSheet As String, srcRange As String, TTL As Boolean, outArr As Variant)
Dim myConn As ADODB.Connection, myCmd As ADODB.Command
Dim HDR As String, myRS As ADODB.Recordset, RS_n As Integer, RS_f As Integer
Dim Arr
Set myConn = New ADODB.Connection
If TTL = True Then HDR = "Yes" Else HDR = "No"
myConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & srcFile & ";" & "Extended Properties=""Excel 8.0;" &_
"HDR="&amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;_
amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;_
amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp; HDR & ";IMEX=1;"""
Set myCmd = New ADODB.Command
myCmd.ActiveConnection = myConn
If srcSheet = "" _
Then myCmd.CommandText = "SELECT * from `" & srcRange & "`" Else: myCmd.CommandText = "SELECT * from `" _
&srcSheet & "$" & srcRange & "`"
Set myRS = New ADODB.Recordset
myRS.Open myCmd, , adOpenKeyset, adLockOptimistic
ReDim Arr(1 To myRS.RecordCount, 1 To myRS.Fields.Count)
myRS.MoveFirst
Do While Not myRS.EOF
For RS_n = 1 To myRS.RecordCount 'lignes
For RS_f = 0 To myRS.Fields.Count - 1 'colonnes
Arr(RS_n, RS_f + 1) = myRS.Fields(RS_f).Value
Next
myRS.MoveNext
Next
Loop
myConn.Close
Set myRS = Nothing
Set myCmd = Nothing
Set myConn = Nothing
outArr = Arr
End Sub
Retourne le username de windows
Function UserNameWindows() As String
Dim lngLen As Long
Dim strBuffer As String
Const dhcMaxUserName = 255
strBuffer = Space(dhcMaxUserName)
lngLen = dhcMaxUserName
UserNameWindows = If (CBool(GetUserName(strBuffer, lngLen)) ,Left$(strBuffer, lngLen - 1),"")
End Function
déplace le curseur de nb positions vers la direction "direction" {Direction = "{LEFT}", "{RIGHT}"}
Sub arrowkeyleft(nb,direction)
for x = 1 to nb
Application.SendKeys "{LEFT}", True
Next
End Sub
Fermeture Automatique (à mettre dans thiworkbook)
Private Sub Workbook_Open()
Debut = Now
FermAuto
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Debut = Now
FermAuto1
End Sub
Exemple à mettre ds un module
Option Explicit
Public Debut, DebutS, Annul As Byte
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub FermAuto()
DebutS = Debut + TimeValue("02:00:00") ' Modifier ici la durée - actuellement 2 h sec.
Application.OnTime DebutS, "FermAuto2"
End Sub
Sub FermAuto1()
On Error Resume Next
Application.OnTime DebutS, "FermAuto2", , "False"
FermAuto
End Sub
Sub FermAuto2()
UserForm1.Show
Application.OnTime Now + TimeValue("00:00:10"), "FermAuto3" 'NE PAS MODIFIER CETTE DUREE
End Sub
Sub FermAuto3()
If Annul <> 1 Then
ActiveWorkbook.Save
On Error Resume Next
Application.OnTime DebutS, "Ferauto2", , "False"
ActiveWorkbook.Close
End If
End Sub
Trouver la position d'un variant dans un array
This function returns the index of an item in a one/two-dimensional array.
The function returns -1 if the item was not found [value: [Variant] Lookup value]
iColumn: (Optional) [Long] If the array has two dimensions, iColumn specifies which column (2nd dimension) will be searched.
iStart: (Optional) [Long] Determines where the search will be started.
Function FindInArray(value, vArray As Variant, Optional iColumn, Optional iStart) As Long
FindInArray = -1
Dim i As Long, iCol As Long, iSta As Long, iTwo As Long
' check if vArray has two dimensions
On Error Resume Next
i = UBound(vArray, 2)
iTwo = IIf(Err.Number = 0, 1, -1)
On Error GoTo 0
' check variables
If IsMissing(iColumn) Or Not IsNumeric(iColumn) Then iCol = iTwo Else iCol = CLng(iColumn)
If IsMissing(iStart) Or Not IsNumeric(iStart) Then iSta = LBound(vArray, 1) Else iSta = CLng(iStart)
If iSta < itwo =" -1" i =" 1" findinarray =" i" i =" iSta" findinarray =" i">LanceIE()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "http://dj.joss.free.fr"
IE.AddressBar = True
IE.MenuBar = True
IE.Toolbar = True
IE.Width = 800
IE.Height = 600
IE.Resizable = True
IE.Visible = True
Set IE = Nothing
End Sub
Donne le num de la semaine de la date fournie
Function NOSEM(D As Date) As Long
D = Int(D)
NOSEM = DateSerial(Year(D + (8 - WeekDay(D)) Mod 7 - 3), 1, 1)
NOSEM = ((D - NOSEM - 3 + (WeekDay(NOSEM) + 1) Mod 7)) \ 7 + 1
End Function
The WorkbookIsOpen Function
Private Function WorkbookIsOpen(wbname) As Boolean
' Returns TRUE if the workbook is open
Dim x As Workbook
On Error Resume Next
Set x = Workbooks(wbname)
If Err = 0 Then WorkbookIsOpen = True _
Else WorkbookIsOpen = False
End Function
Authentification automatique sur un serveur
Function mapping(SourceServer)
Set oNetwork = CreateObject("WScript.Network"): Set oDrives = oNetwork.EnumNetworkDrives
mapping = False
Share = "\\" & SourceServer & "\e$"
For i = 0 To oDrives.Count - 1 Step 2
If LCase(Share) = LCase(oDrives.Item(i + 1)) Then mapping = True: Exit Function
Next
Dim UserName: UserName = InputBox("Compte", "Authentification sur " & SourceServer, oNetwork.UserName)
Dim Password: Password = ""
While Password = "": Password = InputBox("mot de passe pour le Compte " & UserName, "Authentification sur " & SourceServer): Wend
On Error Resume Next: oNetwork.MapNetworkDrive "", "\\" & SourceServer & "\e$", True, UserName, Password: On Error GoTo 0
If (Err.Number > 0) Then MsgBox Err.Description Else mapping = True
Set oNetwork = Nothing: Set oDrives = Nothing
End Function
'Password masked inputbox (original code : Daniel Klann)
'API functions to be used
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
'Constants to be used in our API functions
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0
Private hHook As Long
Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim RetVal
Dim strClassName As String, lngBuffer As Long
If lngCode < HC_ACTION Then NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam): Exit Function
strClassName = String$(256, " ")
lngBuffer = 255
If lngCode = HCBT_ACTIVATE Then 'A window has been activated
RetVal = GetClassName(wParam, strClassName, lngBuffer)
If Left$(strClassName, RetVal) = "#32770" Then SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
'This changes the edit control so that it display the password character *.
End If
CallNextHookEx hHook, lngCode, wParam, lParam 'This line will ensure that any other hooks that may be in place are called correctly.
End Function
Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, Optional YPos, Optional HelpFile, Optional Context) As String
Dim lngModHwnd As Long, lngThreadID As Long
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)
hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
UnhookWindowsHookEx hHook
End Function
Trucs & astuces
Activer l'Auto-Completion, au moment de l'écriture des premiers caractères de l'objet, appuyez sur les touches Ctrl+Espace simultanément.
Renforcer la sécurité du code, et forcer la necessité de déclarer chaque variable, il est d'usage de rajouter en début de Module : Option Explicit
LES FONCTIONS D'OPTIMISATION
blocage/déblocage des evenements : Application.EnableEvents = False/True
Activation/Désactivation du rafraîchissement de l'écran : Application.ScreenUpdating = False/True
choix de l'option par défaut pour toutes question : Application.DisplayAlerts = False/True
Calculs manuel : Application.Calculation = xlCalculationManual
Calculs automatique : Application.Calculation = xlCalculationAutomatic
Calculs d'un range : Range("F2:F8").Calculate
Démarrage de prog, 5 secondes après avoir lancé Test : Application.OnTime Now + TimeValue("00:00:05"), "prog"
OnRepeat, OnUndo, OnWindows
Renforcer la sécurité du code, et forcer la necessité de déclarer chaque variable, il est d'usage de rajouter en début de Module : Option Explicit
LES FONCTIONS D'OPTIMISATION
blocage/déblocage des evenements : Application.EnableEvents = False/True
Activation/Désactivation du rafraîchissement de l'écran : Application.ScreenUpdating = False/True
choix de l'option par défaut pour toutes question : Application.DisplayAlerts = False/True
Calculs manuel : Application.Calculation = xlCalculationManual
Calculs automatique : Application.Calculation = xlCalculationAutomatic
Calculs d'un range : Range("F2:F8").Calculate
Démarrage de prog, 5 secondes après avoir lancé Test : Application.OnTime Now + TimeValue("00:00:05"), "prog"
OnRepeat, OnUndo, OnWindows
| - Cette page à été vue | fois - |
|---|
