Macros-commandes VBA/Lectures et écritures

**Lectures et écritures**
Leçon : Macros-commandes VBA

Chapitre n^o 13
Chap. préc. :	Création de Tableau croisé
Chap. suiv. :	Gestion des droits et répertoires

En raison de limitations techniques, la typographie souhaitable du titre, « Macros-commandes VBA : Lectures et écritures
Macros-commandes VBA/Lectures et écritures », n'a pu être restituée correctement ci-dessus.

Wikibooks-logo.svg

Wikilivres possède un manuel à propos de « Modifier des fichiers en VBS ».

Manipulation de répertoires

Pour 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

Sélectionner un fichier ouvert

Sub MonFichier()
  Workbooks("Nom du fichier").Activate
  ' Choisir une cellule
  Workbooks("Nom du fichier").Worksheets(1).Cells(1, 1)
End Sub

Rechercher des fichiers

Pour 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

Sub 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

Sub 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

Sub Supprimer()
    Dim FSO As Object
    Set FSO = CreateObject("scripting.filesystemobject")
    FSO.DeleteFile "C:\Fichier.txt"
End Sub

Propriétés des fichiers

Pour 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

Si 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

Avant 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

Remarque

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

Sous 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].

Remarque

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

On 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

Le fichier doit être au format PC DOS. La commande dépend ensuite du SGBD, par exemple avec MS-SQL c'est BULK INSERT.

Remarque

Pour afficher une simple sélection de table sans paramètre, la liaison de données d'Excel est une solution plus rapide.

Références

http://www.ozgrid.com/VBA/ExcelRanges.htm
Translinguisme/Programmation#Manipuler_un_fichier_Excel sur Wikilivres

Macros-commandes VBA

Création de Tableau croisé

Gestion des droits et répertoires

[1] ttp://www.techonthenet.com/excel/formulas/getattr.php

[2] ttp://groupes.codes-sources.com/article-recherche-macro-excel-lister-fichiers-dossier-246973.aspx

[3] ttp://msdn.microsoft.com/fr-fr/library/6zwyt2y8.aspx

[4] ttp://www.commentcamarche.net/contents/1174-objet-filesystemobject-fso

[5] ttp://www.techonthenet.com/excel/formulas/setattr.php

[6] ttp://www.clubic.com/forum/programmation/fonction-recherche-vba-excel-id401170-page1.html

[7] ttp://msdn.microsoft.com/en-us/library/office/aa195732%28v=office.11%29.aspx

[8] ttp://msdn.microsoft.com/fr-fr/library/office/ff196143%28v=office.15%29.aspx

[9] ttps://technet.microsoft.com/fr-fr/library/ms131291(v=sql.110).aspx

[1]

[2]

[3]

[4]

[5]

[6]

[7]

[8]

[9]