Macros-commandes VBA/Lectures et écritures
Manipulation de répertoires
modifierPour connaitre le répertoire courant, la fonction dépend du logiciel utilisé :
Sub Repertoires1()
' Dans Excel :
MsgBox ThisWorkbook.Path
' Dans Word :
MsgBox ThisDocument.Path
End Sub
Pour créer un répertoire, il faut préalablement vérifier son inexistence :
Sub Repertoires2()
ChDir ThisWorkbook.Path & "\Test" ' Se rend dans le répertoire "test"
If Dir("monDossier", vbDirectory) = "" Then MkDir ("monDossier") ' Si le répertoire "monDossier" n'existe pas on le crée
End Sub
Pour détruire un répertoire, il faut préalablement vérifier son existence :
Sub Repertoires3()
ChDir ThisWorkbook.Path & "\Test" ' Se rend dans le répertoire "test"
If Dir("monDossier", vbDirectory) <> "" Then RmDir("monDossier") ' Supprime le répertoire "monDossier" si le répertoire "monDossier" existe
End Sub
Pour connaitre le statut d'un objet (répertoire, fichier caché...), utiliser GetAttr()
[1] :
Sub Repertoires4()
Statut = GetAttr(CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\monDossier")
' Si Statut = 16, l’objet "monDossier" qui est sur le bureau est un vrai répertoire
If Statut = 16 Then MsgBox ("Le fichier monDossier est un répertoire", "Analyse de fichier dans répertoire", vbInformation)
End Sub
Pour parcourir un répertoire il faut l'ouvrir et analyser son contenu :
Sub Repertoires5()
Dim repertoire As String
Dim classeur As String
Dim nbrFichiers As Integer
' initialise le répertoire de travail
repertoire = "c:\tests\excel\"
' récupère le premier fichier du répertoire
classeur = Dir(repertoire)
' entame la boucle principale (tant qu’il y a des fichiers dans le répertoire)
Do
' affiche les noms des fichiers trouvés
MsgBox ("Fichier trouvé : " & classeur, "Parcours de répertoire", vbInformation)
nbrFichiers = nbrFichiers + 1
' recherche du fichier suivant
classeur = Dir
Loop While classeur <> ""
' affiche le nombre de fichiers trouvés
MsgBox ("Nombre de Fichiers trouvés : " & nbrFichiers, "Comptage dans répertoire", vbInformation)
End Sub
Manipulation de fichiers
modifierSélectionner un fichier ouvert
modifierSub MonFichier()
Workbooks("Nom du fichier").Activate
' Choisir une cellule
Workbooks("Nom du fichier").Worksheets(1).Cells(1, 1)
End Sub
Rechercher des fichiers
modifierPour rechercher des fichiers Excel en VB 6.3 depuis un fichier .xls[2] :
Sub Liste()
ligne = 2
file = Dir(ThisWorkbook.Path & "\*.xls") 'Premier fichier dans l’ordre alphabétique, dans Windows
Do While file <> "" 'Jusqu'à ce que la recherche soit vide
Cells(ligne, 1) = file 'On écrit le nom du fichier dans une cellule
file = Dir 'Fichier suivant
ligne = ligne + 1
Loop
End Sub
Pour passer au fichier .xls suivant dans le répertoire, il suffit de rappeler Dir() sans paramètre :
file = Dir()
Si le chemin dans la commande Dir() contient deux étoiles, elle retrouvera le même fichier lors de son rappel |
La version postérieure propose un autre mode de recherche[3].
Copier des fichiers
modifierSub Copier()
FileCopy "C:\Fichier.txt", "C:\Temp\Archive.txt"
End Sub
Avec la date du jour pour éviter d'écraser :
Sub Copier2()
FileCopy "C:\Fichier.txt", "C:\Temp\Archive" & Date & ".txt"
End Sub
Déplacer des fichiers
modifierSub Deplacer()
Dim FSO As Object
Set FSO = CreateObject("scripting.filesystemobject")
FSO.MoveFile Source:="C:\Fichier.txt", Destination:="C:\Temp\Archive"
End Sub
PS : cela sert aussi à les renommer[4].
Supprimer des fichiers
modifierSub Supprimer()
Dim FSO As Object
Set FSO = CreateObject("scripting.filesystemobject")
FSO.DeleteFile "C:\Fichier.txt"
End Sub
Propriétés des fichiers
modifierPour modifier les propriétés d'un fichier, utiliser SetAttr
[5] :
Paramètre | Valeur alternative | Description |
---|---|---|
vbNormal | 0 | Fichier normal |
vbReadOnly | 1 | Lecture seule |
vbHidden | 2 | Fichier caché |
vbSystem | 4 | Fichier système |
vbArchive | 32 | Archive |
vbAlias | 64 | Lien symbolique |
Exemple :
SetAttr "C:\Temp\Test.xls", vbHidden
Fichier texte
modifierSi le fichier text.txt n'existe pas le programme le crée, sinon il l'écrase :
Sub Texte()
Open "C:\Users\login\Desktop\text.txt" For Input As #1
MsgBox "Le fichier pèse : " & LOF(1) & " octets"
NbLigne = 0
While Not EOF(1)
Line Input #1, Ligne
MsgBox (Ligne)
NbLigne = NbLigne + 1
Wend
MsgBox "Il contient : " & NbLigne & " lignes."
Print #1, NbLigne
Close #1
End Sub
Line Input est limité à 250 caractères par ligne si on ne déclare pas la variable. Pour éviter qu'elle soit limitée en type String il faut donc spécifier un type :
Dim Ligne as Variant
De plus, si le fichier texte lu est au format UNIX, la fonction Line Input lira tout le fichier en une seule fois, sans pouvoir distinguer les lignes. Il faut donc le convertir (généralement depuis PC ANSI) au format PC DOS au préalable, par exemple avec le freeware Textpad, ou en appliquant sur chaque ligne Replace(Ligne, Chr(10), vbCrLf). |
Pour ajouter une ligne à la fin sans tout relire :
Sub Texte2()
Open "C:\Users\login\Desktop\text.txt" For Binary As #1
Put #1, LOF(1), "Dernière ligne"
Close #1
End Sub
Tableau Excel
modifierAvant de procéder à l'une des deux opération de lecture ou d'écriture, il faut ouvrir le fichier en spécifiant le mode d'ouverture avec la fonction fileopen.
Autre solution, en appelant une macro depuis un fichier Excel, il n’est pas nécessaire rouvrir le fichier[6] :
Sub Tableurs()
' Création d'un classeur vierge
Set FichierResultat = Workbooks.Add()
' Création d'une feuille à la fin du classeur
ActiveWorkbook.Sheets.Add After:=Sheets(ActiveWorkbook.Sheets.Count)
ActiveSheet.Name = "Test"
' Création d'un classeur automatiquement en copiant une feuille
ActiveSheet.Copy
'Modification directe
Sheets(1).Range("A1").Value = "Ce fichier est situé dans "
Sheets(1).Range("B1").Value = ActiveWorkbook.Path '(équivalent à : Sheets("feuille 1").Cells(1, 2).Value = ThisWorkbook.path)
MsgBox(Sheets(1).Range("B1").Value) 'Affichage d'un champ dans une boite à valider
' Parcours de toutes les feuilles du fichier
Dim F as WorkSheet
For Each F in WorkSheets
F.Range("A2").Value = "Feuille lue"
Next F
'Suppression de la ligne C
Rows(3).Delete ' Décalage vers le haut
Rows(3).Delete shift:=xlToLeft ' Décalage vers la gauche
'Copie de B dans C
Rows(2).Select
Selection.Copy
Rows(3).Select
ActiveSheet.Paste ' Ces quatre lignes ne sont pas équivalentes à : Rows(3).Value = Rows(2).Value, car elles respectent les propriétés des cellules (taille, gras, soulignement...)
'Filtre l’affichage des lignes nulles de la colonne 4
ActiveSheet.Range("$A$4:$Z$1000").AutoFilter Field:=4, Criteria1:="<>0", Operator:=xlAnd
'Recherche du mot "numéro"
Cells.Find(what:="numéro").Activate
' Pour une recherche plus ciblée, utiliser : Application.VLOOKUP(lookup_value, table_array, column_index, range_lookup)
'Récupération des coordonnées du mot
Dim Recherche as Variant
Set Recherche = Cells.Find("numéro")
If Not Recherche Is Nothing Then
MsgBox "En " & Recherche.Row & ", " & Recherche.Column & " : " & Cells(Recherche.Row, Recherche.Column).Value
End if
' Sélection d'une plage de cellules
ActiveSheet.Range("A1", "B2").Select ' ou
ActiveSheet.Range(Cells(1, 1), Cells(2, 2)).Select
'Sauvegarde
ActiveWorkbook.Save
'Sauvegarde ailleurs
ActiveWorkbook.SaveAs(ActiveWorkbook.Path & "\" & "NouveauNomDuFichier")
End Sub
Pour recherche plusieurs occurrences d'une chaine sur la même feuille, il faut enregistrer l'adresse de la première sans quoi le programme tourne en boucle[7].
Attention : la fonction Find()
cherche un code contenu dans une cellule, même si elle est plus longue. Pour que la cellule contienne exactement le code recherché, ni plus ni moins, utiliser FindNext()
en plus[8] :
Set Recherche = Cells.Find("numéro")
While Not Recherche Is Nothing And Len(Recherche) <> Len("numéro")
Set Recherche = Cells.FindNext(Recherche)
Wend
Sinon pour manipuler un autre fichier dans un deuxième processus Excel en même temps :
Dim appExcel As Excel.Application
Set appExcel = CreateObject("Excel.Application")
Dim wbExcel As Excel.Workbook
Dim wsExcel As Excel.Worksheet
'Accès à un fichier dans le même répertoire que celui qui appelle le script (l'ActiveWorkbook)
Set wbExcel = appExcel.Workbooks.Open(ActiveWorkbook.Path & "\" & "NomDuFichier")
Set wsExcel = wbExcel.Worksheets(1)
'Traitement
wsExcel.Sheets(1).Range("A1").Value = "Traité"
'Sauvegarde et quitte
wbExcel.Save
wbExcel.Close
appExcel.Quit
La communication inter-processus est 10 fois plus longue que si les deux fichiers sont ouverts avec Application.Workbooks.Open() .
|
Accès aux bases de données
modifierSous Excel, il faut au préalable cocher dans le menu Outils\Références, la bibliothèque ActiveX Data Objects, pour pouvoir stocker les extractions des bases de données dans des objets Recordset (littéralement "jeu d'enregistrement"), comme dans un tableau 2D.
On peut ensuite se connecter en utilisant différents pilotes[9].
Les propriétés BOF et EOF d'un Recordset signifient "beginning of file" (début de fichier) et "end of file" (fin de fichier). Ils s'appliquent aussi aux jeux d'enregistrement (non sérialisés).
Public Function Extraire(Nom) As Boolean
On Error Resume Next
Dim Connection As New ADODB.Connection
Dim Command As New ADODB.Command
Dim Jeu As New ADODB.Recordset
Dim Entetes As ADODB.Fields
Dim Tableau As Variant
' Connexions avec le pilote ODBC
' Pour MySQL :
Connection.ConnectionString = "driver={MySQL ODBC 3.51 Driver};server=MonServeur;uid=MonCompte;pwd=MonMotDePasse;database=MaBase"
' Pour MS-SQL : Connection.ConnectionString = "driver={SQL Server};server=MonServeur;uid=MonCompte;pwd=MonMotDePasse;database=MaBase"
' Pour MS-Access : Connection.ConnectionString = "driver={Microsoft Access Driver (*.mdb)};Dbq=CheminDatabase;Exclusive=0";"
' Connexions avec le pilote OLE DB :
'Connection.ConnectionString = "Provider=SQLOLEDB.1;Data Source=MonServeur;Initial Catalog=MaBase;User ID=MonLogin;password=MonMotDePasse;"
'Connection.ConnectionString = "Provider=SQLOLEDB;Data Source=MonServeur;Initial Catalog=MaBase;Integrated Security=SSPI;"
' Connexions avec le pilote SQL Server Native Client
'Connection.ConnectionString = "Provider=SQLNCLI;Server=MonServeur;DATABASE=MaBase;Trusted_Connection=yes;"
Connection.Open
Command.ActiveConnection = Connection
Command.CommandText = "SELECT MonChamp from MaTable where Nom = '" & Nom & "'"
Set Jeu = Command.Execute
If Jeu.BOF = False And Jeu.EOF = False Then
Tableau = Jeu.GetRows
Set Entetes = Jeu.Fields
End If
MsgBox ("Premier résultat, " & Entetes.Item(0).Name & " : " & Tableau(0, 0))
For L = LBound(Tableau, 2) To UBound(Tableau, 2)
For C = LBound(Tableau, 1) To UBound(Tableau, 1)
ThisWorkbook.ActiveSheet.Cells(L + 1, C + 1).Value = Tableau(C, L)
Next C
Next L
End Function
Lancer une procédure stockée
modifierOn lance ici une procédure stockée avec une chaine de caractères et un entier en paramètres :
Sub SP
Dim Connection As New ADODB.Connection
Dim Command As New ADODB.Command
Dim Jeu As New ADODB.Recordset
Dim Param1, Param2 As ADODB.Parameter
Dim Tableau As Variant
Connection.ConnectionString = "driver={MySQL ODBC 3.51 Driver};server=MonServeur;uid=MonCompte;pwd=MonMotDePasse;database=MaBase"
Connection.Open
Command.ActiveConnection = Connection
Command.CommandText = "MaProcédureStockée"
Set Param1 = Command.CreateParameter("@Nom", adVarChar, adParamInput, 200)
Set Param2 = Command.CreateParameter("@Age", adInteger, adParamInput, 10)
Command.Parameters.Append Param1
Command.Parameters.Append Param2
Param1.Value = "MICHU"
Param2.Value = 49
Set Jeu = Command.Execute
If Jeu.BOF = False And Jeu.EOF = False Then
Tableau = Jeu.GetRows
End If
MsgBox Tableau(0,0)
End Sub
Importer un fichier texte dans une BDD
modifierLe fichier doit être au format PC DOS. La commande dépend ensuite du SGBD, par exemple avec MS-SQL c'est BULK INSERT
.
Références
modifier- ↑ http://www.techonthenet.com/excel/formulas/getattr.php
- ↑ http://groupes.codes-sources.com/article-recherche-macro-excel-lister-fichiers-dossier-246973.aspx
- ↑ http://msdn.microsoft.com/fr-fr/library/6zwyt2y8.aspx
- ↑ http://www.commentcamarche.net/contents/1174-objet-filesystemobject-fso
- ↑ http://www.techonthenet.com/excel/formulas/setattr.php
- ↑ http://www.clubic.com/forum/programmation/fonction-recherche-vba-excel-id401170-page1.html
- ↑ http://msdn.microsoft.com/en-us/library/office/aa195732%28v=office.11%29.aspx
- ↑ http://msdn.microsoft.com/fr-fr/library/office/ff196143%28v=office.15%29.aspx
- ↑ https://technet.microsoft.com/fr-fr/library/ms131291(v=sql.110).aspx
- http://www.ozgrid.com/VBA/ExcelRanges.htm
- Translinguisme/Programmation#Manipuler_un_fichier_Excel sur Wikilivres