Merci beaucoup pour cette solution pratique.
Version imprimable
Merci beaucoup pour cette solution pratique.
Bonjour,
Lors de la copie d'une colonne avec TS_CopierValeurColonne je constate le décalage d'une ligne vers le haut, écrasant ainsi le titre de la colonne.
Cette erreur intervient en RemplacerDonnées (je n'ai pas testé sur ajouter données)
Cette commande prend les données sans le titre de colonne mais copie à partir de la ligne de titre, écrasant ainsi le titre de colonne et décalant toutes les données d'une ligne vers le haut.
j'ai modifié en mettant 2 au lieu de 1
AmicalementCode:
1
2
3
4
5
6
7
8
9 ' Place les données dans la destination: Select Case Méthode Case TS_AjouterDonnées: TS_Dest.Cells(TS_Dest.Rows.Count + 1, Colonne_Dest).Resize(UBound(Copie), 1) = Copie Case TS_RemplacerDonnées: TS_Dest.ListObject.ListColumns(Colonne_Dest).DataBodyRange = "" TS_Dest.Cells(2, Colonne_Dest).Resize(UBound(Copie), 1) = Copie End Select
Salut,
J'ai remarqué que tu appelles souvent Application.ScreenUpdating, Application.EnableEvents, Application.Cursor.
Encore désolé, mais ce n'est pas son job.
La gestion de ces paramètres doit être faite, s'il y a lieux, à un niveau supérieur (en d'autres termes: Le code appelant).
Evolution possibles:
- Copier une plage dans un tableau structuré.
- Ajouter une plage à un tableau structuré.
- Copier un tableau 2D dans un tableau structuré.
- Ajouter un tableau 2D dans un tableau structuré.
- Copier un tableau structuré.
- Ajouter 2 tableaux structurés.
Bonjour Laurent_Ott,
J'ai eu besoin de travailler avec les tableaux structurés pour développer une application sous Excel me servant de proptoype (opérationnel quand même) à un rédéveloppement ensuite plus stable disons (Excel plante encore trop souvent). J'ai fais l'erreur de ne pas rechercher sur ce site ... et ai développé mes propres fonctions ...
Avant tout : quel beau boulot ! Mille bravos ! C'est propre et complet. Certes nous pouvons imaginer de très nombreuses améliorations et façons d'aborder notamment la gestion d'erreur (je pense aux remarques un peu acerbes de deedolith, qui n'a pas forcément tord, mais qui pêchent juste sur la forme à mon sens, son avis n'étant pas celui du maître suprême en matière de dev VBA malgré sa longue et riche expérience ...). Je pense aussi à une gestion de curseurs à la recordset sans utiliser de recordset ... etc ...
J'ai commencé par développer comme toi Laurent un module disposant de tout un tas de fonctions boite à outil me permettant de manipuler les tableaux structurés et leurs contenus. Et puis je me suis heurté à un besoin de plus en plus prégnant : utiliser l'intellisense de VBA pour identifier les colonnes existantes dans un tableau, et utiliser au maximum le compilateur vba pour détecter les erreurs sémantiques sur l'utilisation des noms de colonne à la compilation plutôt qu'à l'exécution.
Pour cela j'ai imaginé et développé ce qui suit et qui est orienté objet.
Par dessus ma boite à outil de manipulation de tables Excel, j'ai développé un code capable de générer une classe miroir d'une table Excel statique. Plusieurs axes de fonctions sont ainsi générés dans la classe :
- des fonctions avec préfixe F_ pour identifier un setter/getter de valeurs de colonne
- des fonctions avec préfixe FN_ pour retourner le nom d'une colonne existante dans la table.
- des fonctions avec préfixe S_ pour rechercher dans une colonne donnée.
- toutes les fonctions de ma boite à outils appelable à partir de ma classe. J'ai implémenté un principe de dérivation de ma classe boite à outil, avec les limites de vba ...
Exemple d'usage : balayage de toutes les lignes de ma table et affichage des données des cellules de chaque ligne.
La classe ClsTblTest aura au préalable été générée de la manière suivante :Code:
1
2
3
4
5
6
7
8
9
10
11 'Déclarer ma classe sur ma table Dim MaTable As New ClsTblTest 'Balayer la table With MaTable Do Until .getCursor() Is Nothing Debug.Print .F_ID, .F_PRENOM, .F_NOM, .F_GRADE .CursorNext Loop End With
- créer une classe from scratch et ajouter ces directives de précompilation :
Je lance ensuite mon précompilateur qui génère ce code :Code:
1
2
3
4 Option Explicit '$DERIVED FROM ClsExcelTable '$STUB FROM EXCELTABLE Thisworkbook.sheets("Tests"), "Test"
Si cela t'intéresse, et intéresse d'autres personnes je peux travailler pour adapter ton code et y ajouter cette couche objet en fournissant le précompilateur VBA que j'ai développé.Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101 Option Explicit '$DERIVED FROM ClsExcelTable '$STUB FROM EXCELTABLE Thisworkbook.sheets("Tests"), "Test" '$DERIVED CODE START - NE PAS MODIFIER ----------------------------------- Public LaMere As New ClsExcelTable ... Function getCursorRowInTable() As Long getCursorRowInTable = LaMere.getCursorRowInTable End Function Function isInColumnRangeActiveCell(ColumnName As String) As Boolean isInColumnRangeActiveCell = LaMere.isInColumnRangeActiveCell(ColumnName) End Function Sub FiltrerColonne(NomColonne As String, C1 As Variant, Optional C2 As Variant) Call LaMere.FiltrerColonne(NomColonne, C1, C2) End Sub Function getSheet() As Worksheet getSheet = LaMere.getSheet End Function Function getColdataRangeFromSheetRow(ColName As String, SheetRow As Long) As Range Set getColdataRangeFromSheetRow = LaMere.getColdataRangeFromSheetRow(ColName, SheetRow) End Function ... 'Stub getters et setters -------------------------------- Private Sub Class_Initialize() LaMere.InitFromSheetAndTableName ThisWorkbook.Sheets("Tests"), "Test" End Sub Public Property Get F_ID() F_ID = LaMere.getCellFromCursor("Id") End Property Public Property Let F_ID(v) LaMere.getCellFromCursor("Id") = v End Property Public Property Get FN_ID() As String FN_ID = "Id" End Property Public Property Get R_ID() As Range Set R_ID = LaMere.getColdataRange("Id") End Property Public Function S_ID(WhatToLookFor As String) As Range Set S_ID = LaMere.searchInColumn("Id", WhatToLookFor) End Function Public Property Get F_NOM() F_NOM = LaMere.getCellFromCursor("Nom") End Property Public Property Let F_NOM(v) LaMere.getCellFromCursor("Nom") = v End Property Public Property Get FN_NOM() As String FN_NOM = "Nom" End Property Public Property Get R_NOM() As Range Set R_NOM = LaMere.getColdataRange("Nom") End Property Public Function S_NOM(WhatToLookFor As String) As Range Set S_NOM = LaMere.searchInColumn("Nom", WhatToLookFor) End Function Public Property Get F_PRENOM() F_PRENOM = LaMere.getCellFromCursor("Prénom") End Property Public Property Let F_PRENOM(v) LaMere.getCellFromCursor("Prénom") = v End Property Public Property Get FN_PRENOM() As String FN_PRENOM = "Prénom" End Property Public Property Get R_PRENOM() As Range Set R_PRENOM = LaMere.getColdataRange("Prénom") End Property Public Function S_PRENOM(WhatToLookFor As String) As Range Set S_PRENOM = LaMere.searchInColumn("Prénom", WhatToLookFor) End Function Public Property Get F_GRADE() F_GRADE = LaMere.getCellFromCursor("Grade") End Property Public Property Let F_GRADE(v) LaMere.getCellFromCursor("Grade") = v End Property Public Property Get FN_GRADE() As String FN_GRADE = "Grade" End Property Public Property Get R_GRADE() As Range Set R_GRADE = LaMere.getColdataRange("Grade") End Property Public Function S_GRADE(WhatToLookFor As String) As Range Set S_GRADE = LaMere.searchInColumn("Grade", WhatToLookFor) End Function
Bonjour,
Comment indiqué en messagerie privée, le problème vient de la déclaration de vos variables que vous déclarez en ListObjet au lieu de Range.
Le code correct est le suivant :
Code:
1
2
3
4
5
6
7 Dim Tab1 As Range, Tab2 As Range Dim resultat As Boolean Set Tab1 = Range("Tableau1") Set Tab2 = Range("Tableau2") resultat = TS_CopierValeurColonne(Tab1, "col1", Tab2, "col1", TS_RemplacerDonnées, False)
Notez également que la feuille du tableau structuré n'a pas besoin d'être indiquée (si elle est dans le classeur actif) car Excel la retrouve automatiquement d'après le nom du tableau structuré.
Une autre façon d'appeler la fonction est de passer en argument directement le tableau sans utiliser une variable intermédiaire, ce qui donne :
Code:
1
2 Dim resultat As Boolean resultat = TS_CopierValeurColonne(Range("Tableau1"), "col1", Range("Tableau2"), "col1", TS_RemplacerDonnées, False)
Bonjour,
j''utilise la fonction TS_Filtres_Poser pour filtrer mon tableau.
"Call TS_Filtres_Poser(Tableau, 3, "<>S48*", xlAnd, "<>S99*")"
cela fonctionne mais dès que je veux ajouter un xland à savoir "Call TS_Filtres_Poser(Tableau, 3, "<>S48*", xlAnd, "<>S20*", xlAnd, "<>S99*")"
cela plante
pourquoi?
Merci pour votre aide
Bonjour,
Je vous propose de boucler sur les lignes de votre tableau pour masquer celles que vous ne souhaitez pas afficher : =S48* ou =S20* ou =S99*
(ou faire l'inverse si vous prenez le problème dans l'autre sens)
Code:
1
2
3
4
5
6
7
8
9 For i = 1 To TS_Nombre_Lignes(Tableau) If TS_InfoCellule(Tableau, 3, i) Like "S48*" = True _ Or TS_InfoCellule(Tableau, 3, i) Like "S20*" = True _ Or TS_InfoCellule(Tableau, 3, i) Like "S99*" = True _ Then y = TS.Row + i - 1 Rows(y).Hidden = True End If Next i
Et pour afficher toutes les lignes :
Code:Tableau.Rows.Hidden = False
Cordialement.
Bonjour,
tout d'abord, bravo Laurent pour ce travail.
j'ai un petit soucis, il y a une procédure pour importer un tableau depuis un fichier extérieur fermé, ...mais je n'ai rien trouvé pour exporter dans un tableau extérieur fermé.
J'ai un ensemble de tableaux structurés dans un fichier, et j'aimerai, après différentes modifs, pouvoir mettre à jour ces tableaux sans ouvrir les fichiers sources.
Est-ce possible ?
Bonjour,
Je vais étudier ce cas et vous tiendrai informé.
Bonne continuation.
Bonjour,
J'imagine que vous souhaitez mettre à jour les tableaux d’un classeur extérieur fermé à partir d’un classeur ouvert, sans que l’utilisateur soit perturbé par l’affichage du classeur.
Je vous propose la solution suivante, qui ouvre le fichier extérieur avec Excel mais le masque immédiatement avec l’instruction Windows().Visible = False.
Cela permet d’utiliser les fonctions du module « TS » sans incidence sur l’affichage.
Pensez à rendre visible le classeur avant de l’enregistrer.
Ce qui pourrait donner ce code simplifié dans le cas où il faut remplacer les données du tableau "TS_Eleves" contenues dans le classeur "C:\Users\ott_l\Downloads\Test_TS.xlsm" par les données du tableau "TS_Eleves" du classeur actif :
Attention, avant tout il faut s’assurer que le fichier à modifier existe, qu’il ne soit pas déjà ouvert, qu’il ne soit pas en lecture seule.Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20 '------------------------------------------------------------------------------------------------ Sub Exemple() '------------------------------------------------------------------------------------------------ Dim Wk As Workbook Set Wk = Workbooks.Open("C:\Users\ott_l\Downloads\Test_TS.xlsm") Windows(Wk.Name).Visible = False Dim TD As Range Set TD = Wk.Sheets("Feuil1").Range("TS_Eleves") Dim TS As Range Set TS = Range("TS_Eleves") Call TS_CopierUnTableau(TS, TD, TS_RemplacerDonnées, TS_Valeurs) Windows(Wk.Name).Visible = True Wk.Save End Sub '------------------------------------------------------------------------------------------------
L’ouverture du fichier peut déclencher l’événement « Workbook_Open » ou la mise à jour des liaisons, ce qui n’est pas toujours souhaité.
J’ai donc conçu une fonction générique qui prend en charge ces problèmes ainsi que la gestion des erreurs.
Le premier argument est classique, c’est le fichier à ouvrir, le deuxième est plus curieux car il représente le nom de la macro personnelle à exécuter pour la mise à jour du fichier. Car pour un usage générique il n’est pas possible d’avoir ces traitements à l’intérieur de la fonction, il faut les externaliser.
Les autres arguments sont facultatifs, ils définissent les éventuels mots de passes, s’il faut mettre à jour ou non les liaisons et les événements.
En reprenant notre exemple, où les traitements sont réalisés par la fonction « MonTraitementPersonnel » contenue dans le module « Module1 » cela donne ceci :
L’ouverture du classeur à modifier se fait par l’appel à la fonction « TS_OuvrirClasseurInvisible » comme dans cet exemple :
Code:
1
2
3
4
5
6 '------------------------------------------------------------------------------------------------ Sub Exemple() '------------------------------------------------------------------------------------------------ Call TS_OuvrirClasseurInvisible("C:\Users\ott_l\Downloads\Test_TS.xlsm", "Module1.MonTraitementPersonnel") End Sub '------------------------------------------------------------------------------------------------
Qui fait référence à cette fonction du « Module1 » pour la copie du tableau :
Code:
1
2
3
4
5
6 '------------------------------------------------------------------------------------------------ Sub MonTraitementPersonnel(Wk As Workbook) '------------------------------------------------------------------------------------------------ Call TS_CopierUnTableau(Range("TS_Eleves"), Wk.Sheets("Feuil1").Range("TS_Eleves"), TS_RemplacerDonnées, TS_Valeurs) End Sub '------------------------------------------------------------------------------------------------
Le code de la fonction :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127 '------------------------------------------------------------------------------------------------------ Public Function TS_OuvrirClasseurInvisible(Fichier As String, _ FonctionPersonnelle As String, _ Optional MotDePasseOuverture As String = "", _ Optional MotDePasseEcriture As String = "", _ Optional MAJ_Liens As Boolean = False, _ Optional DésactiveMacros As Boolean = True) As Boolean '------------------------------------------------------------------------------------------------------ ' Ouvre un classeur Excel en le mettant invisible pour que l'utilisateur ne soit pas perturbé par les ' manipulations qui y sont faites. '------------------------------------------------------------------------------------------------------ ' Fichier : le classeur Excel qu'il faut ouvrir (chemin complet + nom avec l'extension). ' FonctionPersonnelle : nom de la fonction personnelle à exécuter, précédé du nom du module où elle se trouve. ' La fonction doit avoir en argument un classeur, qui sera le classeur ouvert. ' Par exemple : Sub MonTraitementPersonnel(Wk As Workbook) ' MotDePasseOuverture : éventuellement le mot de passe pour ouvrir le fichier (vide si non nécessaire). ' MotDePasseEcriture : éventuellement le mot de passe pour modifier le fichier (vide si non nécessaire). ' MAJ_Liens : mettre Vrai s'il faut faire une mise à jour des liens à l'ouverture du classeur. ' DésactiveMacros : mettre Vrai pour désactiver les macros et les événements y compris Workbook_Open. '------------------------------------------------------------------------------------------------------ ' La fonction renvoie Vrai si tout s'est bien passé, Faux dans le cas contraire. '------------------------------------------------------------------------------------------------------ ' Exemple d'utilisation pour remplacer les données du tableau "TS_Eleves" contenues dans le classeur ' "C:\Users\ott_l\Downloads\Test_TS.xlsm" par les données du tableau "TS_Eleves" du classeur actif: ' 'Sub Example() 'Call TS_OuvrirClasseurInvisible("C:\Users\ott_l\Downloads\Test_TS.xlsm", "Module1.MonTraitementPersonnel") 'End Sub ' 'Sub MonTraitementPersonnel(Wk As Workbook) 'Call TS_CopierUnTableau(Range("TS_Eleves"), Wk.Sheets("Feuil1").Range("TS_Eleves"), TS_RemplacerDonnées, TS_Valeurs) 'End Sub '------------------------------------------------------------------------------------------------------ Dim Wk As Workbook Dim Filenum As Long, Anc_Attributs As Long Dim ObjFile As Object Dim AncienCancelkey As Long Dim AncienCursor As Long Dim AncienScreenUpdating As Boolean Dim AncienEnableEvents As Boolean ' Gestion des erreurs: On Error GoTo Gest_Err Err.Clear ' Une erreur est déclenchée si le fichier source n'est pas trouvé: Set ObjFile = CreateObject("Scripting.FileSystemObject").GetFile(Fichier) ' Supprime l'attribut lecture seule: Anc_Attributs = ObjFile.Attributes ObjFile.Attributes = 0 ' Une erreur est déclenchée s'il est déjà ouvert: Filenum = FreeFile() Open Fichier For Binary Lock Read Write As #Filenum Close Filenum ' Mémorise les anciens états: AncienCursor = Application.Cursor AncienScreenUpdating = Application.ScreenUpdating AncienEnableEvents = Application.EnableEvents ' Bloque la mise à jour de l'écran: Application.Cursor = xlWait Application.ScreenUpdating = False ' Empêche l'utilisateur d'interrompre le traitement avec Echap: AncienCancelkey = Application.EnableCancelKey Application.EnableCancelKey = xlDisabled ' Désactive les macros pour ouvrir le fichier sans lancer "Workbook_Open": If UCase(Right(Fichier, 5)) <> ".XLSX" And DésactiveMacros = True Then Dim secAutomation As MsoAutomationSecurity secAutomation = Application.AutomationSecurity Application.AutomationSecurity = msoAutomationSecurityForceDisable ' Désactive les événements: Application.EnableEvents = False ' Ouvre le fichier (sans mettre à jour les liens si MAJ_Liens=False): Set Wk = Workbooks.Open(Fichier, MAJ_Liens, False, , MotDePasseOuverture, MotDePasseEcriture, True) ' Réactive les macros: Application.AutomationSecurity = secAutomation Else ' Ouvre le fichier (sans mettre à jour les liens si MAJ_Liens=False): Set Wk = Workbooks.Open(Fichier, MAJ_Liens, False, , MotDePasseOuverture, MotDePasseEcriture, True) End If ' Masque le classeur que l'on vient d'ouvrir: Windows(Wk.Name).Visible = False ThisWorkbook.Activate ' Lance mes traitements: Call Application.Run(FonctionPersonnelle, Wk) ' Réaffiche le classeur et l'enregistre: Windows(Wk.Name).Visible = True Wk.Activate Application.WindowState = xlMinimized Wk.Save ' Renvoie Vrai: TS_OuvrirClasseurInvisible = True ' Fin du traitement: Gest_Err: ' Ferme le classeur s'il est ouvert: If Not Wk Is Nothing Then Wk.Saved = True: Wk.Close ' Restaure les anciens attributs du classeur: If Not ObjFile Is Nothing Then ObjFile.Attributes = Anc_Attributs ' Active l'écran: ThisWorkbook.Activate ' Réactive l'ancienne configuration: Application.EnableCancelKey = AncienCancelkey Application.Cursor = AncienCursor Application.ScreenUpdating = AncienCursor Application.EnableEvents = AncienEnableEvents If Err.Number <> 0 Then Application.Cursor = xlDefault MsgBox Err.Number & " : " & Err.Description, vbInformation, Application.Name Application.Cursor = AncienCursor End If Err.Clear End Function '------------------------------------------------------------------------------------------------------
A noter que l'ouverture d'un gros fichier avec une connexion lente provoque l'affichage par Windows d'une barre de progression du chargement, que l'utilisateur peut annuler. Idem pour l'enregistrement.
Cordialement.
Je pense que ces dernières fonctionnalités sont hors sujet.
En effet, tu commences à gérer des classeurs, ce qui n'a rien à voir avec les tableaux structurés.
Par respect du SRP, cela doit être fait au niveau supérieur (en dehors des fonctions).
Bonjour,
déjà merci pour le code.
je vais décortiquer tout ça et reviens vous dire.
Bonjour,
merci Laurent, tout marche parfaitement.
A deedolith, je ne vois pas pourquoi hors sujet. Comme je l'ai dit dans mon premier message, il y a une fonction pour importer un tableau, pourquoi pas une fonction pour exporter ce tableau !
Une fonction nommée TS_OuvrirClasseurInvisible, comme son nom l'indique, tente d'ouvrir un classeur.
Sans regarder son implémentation, cela pose déjà question:
Quel est le rapport direct avec la gestion des tableaux structurés ?
En regardant l'implémentation, on s'aperçoit que cette dernière ne manipule aucun tableau, ce qui pose la même question une second fois.
Utilisée en interne (donc private), cela à du sens, l'utilisateur final ne se soucie pas de l'implémentation (et il n'a pas à s'en soucier).
Sur l'export / import de données, la bibliothèque va acquérir une ressource (ouvrir un fichier / connexion a une BDD ect ...), realiser l'import (ou export), libérer la ressource.
C'est le comportement qu'on attend (gestion des ressources internes transparentes).
Par contre, mettre a disposition les ressources internes à l'utilisateur final .., c'est la porte ouverte à toutes les bêtises possibles et imaginables (et viol du principe d'encapsulation).
Et par expérience, lorsque l'on laisse une porte ouverte, les ennuis s'y engouffrerons tôt ou tard, ce n'est qu'une question de temps.
On peut faire l'analogie avec ta maison que tu désires repeindre.
Tu donnes accès aux ouvriers à l'extérieur de ta maison (tu leur fournit le service: "Accéder à l'extérieur").
Maintenant imagine que tu leurs fournisse le service: "Accéder à l'intérieur".
- S'il sont honnetes, pas de problème.
- S'ils le sont moins .... surprises surprises.
Je suis d'accord avec Deedolith.
Un module de gestion de tables ne doit pas offrir au code client du module autre chose que des manipulations de tables. Si le module veut offrir un transfert de tables entre classeurs, la gestion de ces derniers doit être invisible pour l'utilisateur qui ne doit pas lui-même ouvrir le classeur.
On pourrait avoir une signature telle que celles-ci:
TransfererVersClasseur(ts As Range, Filename As String) et RecupererDuClasseur(FileName As String, Target As Range)
Ainsi, le code client ne manipule pas les classeurs, et les mécanismes d'ouverture/fermeture de ces derniers lui sont invisibles.
C'est cela, placer une couche d'abstraction => Permettre au code client de faire abstraction des manipulations. Sinon, la couche perd beaucoup de son intérêt.
Je reste toujours sur ma faim quant à la manipulation de Range nommés TS dans un module qui manipule des tables. TS induit un Tableau Structuré (un ListObject) et on ne devrait donc pas nommer un Range TS.
Ce n'est pas votre demande initiale mais l'on pourrait aussi avoir besoin d'ouvrir plusieurs classeurs en même temps, en les masquant pour que les différents traitements réalisés soient transparents pour l'utilisateur.
Par exemple, depuis un fichier "console" qui contient le code VBA, remplacer les données du tableau "TS_Eleves" contenues dans le classeur externe "C:\Users\ott_l\Downloads\Test_TS.xlsm" sur la feuille "Feuil1" par les données du tableau "TS_Eleves" du classeur externe "C:\Users\ott_l\Downloads\Classeur_Elèves.xlsx" en feuille "Feuil1".
Je propose pour faire cela les fonctions ci-dessous.
A noter que pour les traitements je force le mode Lecture/écriture en modifiant les attributs des fichiers. Pour mémoriser les attributs d'origine, je les stocke temporairement dans les propriétés du classeur (afin de ne pas avoir recours à des variables "Private" ou "Public"), puis je les efface en fin de traitement.
Soit deux fonctions :
- "OuvrirClasseur" pour ouvrir un fichier en le forçant en lecture/écriture, en indiquant s'il faut ou non le rendre visible (plus les paramètres déjà vus pour les mots de passe et les liens) ;
- "FermerClasseur" pour le refermer et l'enregistrer si besoin.
Les trois fonctions "PropriétéEcrire", "PropriétéEcrire" et "PropriétéSupprimer" sont utilisées pour la gestion des propriétés personnelles du classeur.
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31 '------------------------------------------------------------------------------------------------ Sub Exemple() '------------------------------------------------------------------------------------------------ On Error GoTo Gest_Err Err.Clear Dim Wk_S As Workbook Set Wk_S = OuvrirClasseur("C:\Users\ott_l\Downloads\Classeur_Elèves.xlsx", False) ' Ouvre le classeur qui contient le tableau source. Dim Wk_D As Workbook Set Wk_D = OuvrirClasseur("C:\Users\ott_l\Downloads\Test_TS.xlsm", False) ' Ouvre le classeur à modifier. Dim TS As Range: Set TS = Wk_S.Sheets("Feuil1").Range("TS_Eleves") ' Définition du tableau source. Dim TD As Range: Set TD = Wk_D.Sheets("Feuil1").Range("TS_Eleves") ' Définition du tableau destination à remplacer. Call TS_CopierUnTableau(TS, TD, TS_RemplacerDonnées, TS_Valeurs) ' Remplace les données. Call TS_FormatColonne(TD, "Note", "0.0", True) ' Force le format numérique de la colonne. Call FermerClasseur(Wk_S, False) ' Ferme la source sans l'enregistrer. Call FermerClasseur(Wk_D, True) ' Ferme la destination et l'enregistre. ThisWorkbook.Activate MsgBox "fin" ' Gestion des erreurs: Gest_Err: If Err.Number <> 0 Then MsgBox Err.Number & " : " & Err.Description, vbExclamation Err.Clear End Sub '------------------------------------------------------------------------------------------------
Les fonctions :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225 '------------------------------------------------------------------------------------------------------ Public Function OuvrirClasseur(Fichier As String, _ Visible As Boolean, _ Optional MotDePasseOuverture As String = "", _ Optional MotDePasseEcriture As String = "", _ Optional MAJ_Liens As Boolean = False, _ Optional DésactiveMacros As Boolean = True) As Workbook '------------------------------------------------------------------------------------------------------ ' Ouvre un classeur Excel en le mettant invisible si "Visible" = False pour que l'utilisateur ne soit pas perturbé par les ' manipulations qui y sont faites. Un fichier en lecture seule peut être modifié car la fonction fait sauter ' cet attribut temporairement puis le remet à la fermeture par la fonction "FermerClasseur". '------------------------------------------------------------------------------------------------------ ' Fichier : le classeur Excel qu'il faut ouvrir (chemin complet + nom avec l'extension). ' Visible : False pour masquer le classeur. ' MotDePasseOuverture : éventuellement le mot de passe pour ouvrir le fichier (vide si non nécessaire). ' MotDePasseEcriture : éventuellement le mot de passe pour modifier le fichier (vide si non nécessaire). ' MAJ_Liens : mettre Vrai s'il faut faire une mise à jour des liens à l'ouverture du classeur. ' DésactiveMacros : mettre Vrai pour désactiver les macros et les événements y compris Workbook_Open. '------------------------------------------------------------------------------------------------------ ' La fonction renvoie l'objet Workbook du classeur si tout s'est bien passé, Nothing dans le cas contraire. '------------------------------------------------------------------------------------------------------ ' Exemple d'utilisation pour remplacer les données du tableau "TS_Eleves" contenues dans le classeur ' "C:\Users\ott_l\Downloads\Test_TS.xlsm" sur la feuille "Feuil1" par les données du tableau "TS_Eleves" ' du classeur "C:\Users\ott_l\Downloads\Classeur_Elèves.xlsx" en feuille "Feuil1": ' 'On Error GoTo Gest_Err 'Err.Clear ' 'Dim Wk_S As Workbook 'Set Wk_S = OuvrirClasseur("C:\Users\ott_l\Downloads\Classeur_Elèves.xlsx", False) ' 'Dim Wk_D As Workbook 'Set Wk_D = OuvrirClasseur("C:\Users\ott_l\Downloads\Test_TS.xlsm", False) ' 'Dim TS As Range: Set TS = Wk_S.Sheets("Feuil1").Range("TS_Eleves") 'Dim TD As Range: Set TD = Wk_D.Sheets("Feuil1").Range("TS_Eleves") ' 'Call TS_CopierUnTableau(TS, TD, TS_RemplacerDonnées, TS_Valeurs) 'Call TS_FormatColonne(TD, "Note", "0.0", True) ' 'Call FermerClasseur(Wk_S, False) 'Call FermerClasseur(Wk_D, True) ' 'ThisWorkbook.Activate 'MsgBox "fin" ' 'Gest_Err: 'If Err.Number <> 0 Then MsgBox Err.Number & " : " & Err.Description, vbExclamation 'Err.Clear '------------------------------------------------------------------------------------------------------ Dim Wk As Workbook Dim Filenum As Long Dim ObjFile As Object Dim Anc_ScreenUpdating As Boolean Dim Anc_Attributs As Long Dim Anc_Wk As Workbook ' Gestion des erreurs: On Error GoTo Gest_Err Err.Clear ' Mémorise le classeur actif: Set Anc_Wk = ActiveWorkbook ' Une erreur est déclenchée si le fichier source n'est pas trouvé: Set ObjFile = CreateObject("Scripting.FileSystemObject").GetFile(Fichier) ' Supprime l'attribut lecture seule: Anc_Attributs = ObjFile.Attributes ObjFile.Attributes = 0 ' Une erreur est déclenchée s'il est déjà ouvert: Filenum = FreeFile() Open Fichier For Binary Lock Read Write As #Filenum Close Filenum ' Bloque la mise à jour de l'écran: Anc_ScreenUpdating = Application.ScreenUpdating Application.ScreenUpdating = False ' Désactive les macros pour ouvrir le fichier sans lancer "Workbook_Open": If UCase(Right(Fichier, 5)) <> ".XLSX" And DésactiveMacros = True Then Dim secAutomation As MsoAutomationSecurity secAutomation = Application.AutomationSecurity Application.AutomationSecurity = msoAutomationSecurityForceDisable ' Désactive les événements: Application.EnableEvents = False ' Ouvre le fichier (sans mettre à jour les liens si MAJ_Liens=False): Set Wk = Workbooks.Open(Fichier, MAJ_Liens, False, , MotDePasseOuverture, MotDePasseEcriture, True) ' Réactive les macros: Application.AutomationSecurity = secAutomation Else ' Ouvre le fichier (sans mettre à jour les liens si MAJ_Liens=False): Set Wk = Workbooks.Open(Fichier, MAJ_Liens, False, , MotDePasseOuverture, MotDePasseEcriture, True) End If ' Mémorise les informations utilisées pour la fermeture dans les propriétés du classeur: Call PropriétéEcrire("MémoClasseur_Fichier", Fichier) Call PropriétéEcrire("MémoClasseur_Attributs", Anc_Attributs) ' Masque (ou non) le classeur que l'on vient d'ouvrir: Windows(Wk.Name).Visible = Visible ' Active le classeur appelant: Anc_Wk.Activate ' Renvoie le classeur: Set OuvrirClasseur = Wk ' Gestion des erreurs: Gest_Err: Application.ScreenUpdating = Anc_ScreenUpdating If Err.Number <> 0 Then If Not ObjFile Is Nothing Then ObjFile.Attributes = PropriétéLire("MémoClasseur_Attributs") Err.Raise Err.Number End If End Function '------------------------------------------------------------------------------------------------------ Public Function FermerClasseur(Classeur As Workbook, Enregistrer As Boolean) As Boolean '------------------------------------------------------------------------------------------------------ Dim ObjFile As Object Dim Anc_ScreenUpdating As Boolean Dim Fichier As String Dim Attributs As Long ' Gestion des erreurs: On Error GoTo Gest_Err Err.Clear ' Bloque la mise à jour de l'écran: Anc_ScreenUpdating = Application.ScreenUpdating Application.ScreenUpdating = False ' Récupère les propriétés du classeur: Classeur.Activate Fichier = PropriétéLire("MémoClasseur_Fichier") Attributs = PropriétéLire("MémoClasseur_Attributs") ' S'il faut l'enregistrer: If Enregistrer = True Then Windows(Classeur.Name).Visible = True Application.WindowState = xlMinimized Call PropriétéSupprimer("MémoClasseur_Attributs") Call PropriétéSupprimer("MémoClasseur_Fichier") Classeur.Save End If ' Ferme le fichier: Classeur.Saved = True Classeur.Close ' Restaure les anciens attributs du classeur: If Attributs <> 0 Then ' Une erreur est déclenchée si le fichier source n'est pas trouvé: Set ObjFile = CreateObject("Scripting.FileSystemObject").GetFile(Fichier) ObjFile.Attributes = Attributs End If ' Renvoie Vrai: FermerClasseur = True ' Gestion des erreurs: Gest_Err: Application.ScreenUpdating = Anc_ScreenUpdating If Err.Number <> 0 Then Err.Raise Err.Number End Function '---------------------------------------------------------------------------------------- Private Function PropriétéEcrire(NomPropriété As String, ValPropriété As Variant, _ Optional TypePropriété As MsoDocProperties = msoPropertyTypeString) As Boolean '---------------------------------------------------------------------------------------- ' Ecrit la propriété NomPropriété avec la valeur ValPropriété au format String par défaut ' dans le classeur actif. '---------------------------------------------------------------------------------------- On Error GoTo Gest_Err ' Supprime la propriété si elle existe déjà: Call PropriétéSupprimer(NomPropriété) ' Crée la propriété et retourne True si tout se passe bien: ActiveWorkbook.CustomDocumentProperties.Add Name:=NomPropriété, value:=ValPropriété, _ Type:=TypePropriété, LinkToContent:=False PropriétéEcrire = True ' Efface les erreurs: Gest_Err: Err.Clear End Function '---------------------------------------------------------------------------------------- Private Function PropriétéLire(NomPropriété As String) As Variant '---------------------------------------------------------------------------------------- ' Lit la propriété NomPropriété dans le classeur actif et renvoie sa valeur. '---------------------------------------------------------------------------------------- On Error GoTo Gest_Err ' Lit la propriété: PropriétéLire = ActiveWorkbook.CustomDocumentProperties.Item(NomPropriété).value ' Efface les erreurs: Gest_Err: Err.Clear End Function '---------------------------------------------------------------------------------------- Private Function PropriétéSupprimer(NomPropriété As String) As Boolean '---------------------------------------------------------------------------------------- ' Supprime la propriété NomPropriété dans le classeur actif, ' ou toutes les propriétés si NomPropriété = "" '---------------------------------------------------------------------------------------- Dim p As DocumentProperty On Error GoTo Gest_Err If NomPropriété <> "" Then ActiveWorkbook.CustomDocumentProperties.Item(NomPropriété).Delete Else ' Boucle sur les propriétés du classeur actif: For Each p In ActiveWorkbook.CustomDocumentProperties ActiveWorkbook.CustomDocumentProperties.Item(p.Name).Delete Next End If PropriétéSupprimer = True ' Efface les erreurs: Gest_Err: Err.Clear End Function '----------------------------------------------------------------------------------------
Bonne Continuation.
Je pense que tu n'as pas compris no remarques:
Dans le cadre de cette librairie dont le but est de gérer les tableaux structurés,
tu peux, en interne, ouvrir / fermer autant de classeurs que tu veux, ce sont des ressources internes.
Par contre, mettre à disposition les ressources internes auprès des utilisateurs (programmeurs) finaux, est une faute, ce n'est pas le but de la librairie.
Les fonctions permettant d'ouvrir / fermer les classeurs doivent par conséquent être privées.
Deedolith,
Je pense que Laurent a compris, mais c'est son module et donc, il en fait ce qu'il veut. Cela dit, ça déforce clairement l'outil qui va devenir un fourre-tout informe. Dommage.
Laurent,
Par rapport à ton code d'hier qui montre l'appel à un msgbox => les fonctions d'un module de ce type ne peuvent afficher un msgbox à l'utilisateur. Ce n'est tout simplement pas leur rôle. Soit on lève une erreur, soit la fonction renvoie une valeur qui sera traitée par le code appelant et qui lui, décidera d'afficher ou non un message, mais les fonctions de ton module ne peuvent pas interagir avec l'utilisateur, même optionnellement. Cela enfreint les règles de programmation qui veulent que des "couches" du programme soient dédiées à des actions précises:
- La couche de présentation qui gère les interactions avec l'utilisateur
- La couche Métier qui gère les problématiques métier
- La couche d'accès aux données qui gèrent les interaction avec les systèmes de stockage de données, dont les tables Excel.
Seule la couche de présentation peut interagir avec l'utilisateur. Les couches métier et d'accès aux données ne peuvent JAMAIS le faire. Dans certains développements légers, on accepte que la DAL (couche d'accès aux données) interagisse directement avec la PL, mais jamais avec l'utilisateur.
Purée, ça m'avait échappé...
Je viens de voir des fonctions du module qui manipulent un combobox. Normalement, le module de gestion TS ne peut, à nouveau, pas communiquer avec l'utilisateur => on ne peut pas avoir une gestion des Combobox dans le module.
Les fonctions doivent recevoir les infos du combo via le code client, sinon, on enfreint les règles de bonne pratique et de séparation des responsabilités. Le module TS fait partie de la couche d'accès aux données et ne peut donc jamais communiquer avec l'utilisateur.
Finalement il n'est pas nécessaire de stocker l'attribut et le nom complet du classeur d'origine.
Il suffit de restaurer l'attribut dès l'ouverture du classeur faite, et le nom complet s'obtient par "Workbook.FullName".
De même pour retrouver le nom de la feuille d'un tableau structuré il suffit de boucler sur les feuilles du classeur et de tester le nom des tableaux (Worksheets.ListObjects.Name).
Ce que fait la fonction "TS_RangeDansClasseur".
Dans l'exemple ci-dessous j'ai repris l'énoncé du message #58 mais sans désactiver les macros du classeur destination car il en contient une pour la mise en forme que je lance par "Application.Run".
Les fonctions proposées, que vous adapterez si besoin:Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40 '------------------------------------------------------------------------------------------------ Sub Exemple() '------------------------------------------------------------------------------------------------ On Error GoTo Gest_Err Err.Clear Dim Wk_S As Workbook Set Wk_S = OuvrirClasseur("C:\Users\ott_l\Downloads\Classeur_Elèves.xlsx", False) Dim Wk_D As Workbook Set Wk_D = OuvrirClasseur(Fichier:="C:\Users\ott_l\Downloads\Test_TS.xlsm", Visible:=False, DésactiveMacros:=False) Dim TS As Range: Set TS = TS_RangeDansClasseur(Wk_S, "TS_Eleves") Dim TD As Range: Set TD = TS_RangeDansClasseur(Wk_D, "TS_Eleves") Call TS_Filtres_Poser(TS, "Note", ">10") ' Sélectionne les notes supérieures à 10. Call TS_SupprimerLignesMasquées(TS) ' Supprime les lignes non sélectionnées. Call TS_CopierUnTableau(TS, TD, TS_RemplacerDonnées, TS_Valeurs) ' Remplace le tableau destination. Wk_D.Activate ' Active le tableau destination. Application.Run "Test_TS.xlsm!'MiseEnForme'" ' Lance sa macro de mise en forme. ThisWorkbook.Activate ' Revient sur la console Call FermerClasseur(Wk_S, False) ' Ferme la source sans l'enregister. Call FermerClasseur(Wk_D, True) ' Ferme la destination en l'enregistrant. MsgBox "fin" Gest_Err: If Err.Number <> 0 Then MsgBox Err.Number & " : " & Err.Description, vbExclamation Call FermerClasseur(Wk_S, False) Call FermerClasseur(Wk_D, True) End If Err.Clear End Sub '------------------------------------------------------------------------------------------------
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192 '------------------------------------------------------------------------------------------------------ Public Function OuvrirClasseur(Fichier As String, _ Visible As Boolean, _ Optional MotDePasseOuverture As String = "", _ Optional MotDePasseEcriture As String = "", _ Optional MAJ_Liens As Boolean = False, _ Optional DésactiveMacros As Boolean = True) As Workbook '------------------------------------------------------------------------------------------------------ ' Ouvre un classeur Excel en le mettant invisible si "Visible" = False pour que l'utilisateur ne soit pas perturbé par les ' manipulations qui y sont faites. Un fichier en lecture seule peut être modifié car la fonction fait sauter ' cet attribut temporairement puis le remet à la fermeture par la fonction "FermerClasseur". '------------------------------------------------------------------------------------------------------ ' Fichier : le classeur Excel qu'il faut ouvrir (chemin complet + nom avec l'extension). ' Visible : False pour masquer le classeur. ' MotDePasseOuverture : éventuellement le mot de passe pour ouvrir le fichier (vide si non nécessaire). ' MotDePasseEcriture : éventuellement le mot de passe pour modifier le fichier (vide si non nécessaire). ' MAJ_Liens : mettre Vrai s'il faut faire une mise à jour des liens à l'ouverture du classeur. ' DésactiveMacros : mettre Vrai pour désactiver les macros et les événements y compris Workbook_Open. '------------------------------------------------------------------------------------------------------ ' La fonction renvoie l'objet Workbook du classeur si tout s'est bien passé. '------------------------------------------------------------------------------------------------------ ' Exemple d'utilisation pour remplacer les données du tableau "TS_Eleves" contenues dans le classeur ' "C:\Users\ott_l\Downloads\Test_TS.xlsm" sur la feuille "Feuil1" par les données du tableau "TS_Eleves" ' du classeur "C:\Users\ott_l\Downloads\Classeur_Elèves.xlsx" en feuille "Feuil1": ' 'On Error GoTo Gest_Err 'Err.Clear ' 'Dim Wk_S As Workbook 'Set Wk_S = OuvrirClasseur("C:\Users\ott_l\Downloads\Classeur_Elèves.xlsx", False) ' 'Dim Wk_D As Workbook 'Set Wk_D = OuvrirClasseur("C:\Users\ott_l\Downloads\Test_TS.xlsm", False) ' 'Dim TS As Range: Set TS = Wk_S.Sheets("Feuil1").Range("TS_Eleves") 'Dim TD As Range: Set TD = Wk_D.Sheets("Feuil1").Range("TS_Eleves") ' 'Call TS_CopierUnTableau(TS, TD, TS_RemplacerDonnées, TS_Valeurs) 'Call TS_FormatColonne(TD, "Note", "0.0", True) ' 'Call FermerClasseur(Wk_S, False) 'Call FermerClasseur(Wk_D, True) ' 'MsgBox "fin" ' 'Gest_Err: 'If Err.Number <> 0 Then ' MsgBox Err.Number & " : " & Err.Description, vbExclamation ' Call FermerClasseur(Wk_S, False) ' Call FermerClasseur(Wk_D, True) 'End If 'Err.Clear '------------------------------------------------------------------------------------------------------ Dim Wk As Workbook Dim Filenum As Long Dim ObjFile As Object Dim Anc_ScreenUpdating As Boolean Dim Attributs As Long Dim Anc_Wk As Workbook ' Gestion des erreurs: On Error GoTo Gest_Err Err.Clear ' Bloque la mise à jour de l'écran: Anc_ScreenUpdating = Application.ScreenUpdating Application.ScreenUpdating = False ' Mémorise le classeur actif: Set Anc_Wk = ActiveWorkbook ' Une erreur est déclenchée si le fichier source n'est pas trouvé: Set ObjFile = CreateObject("Scripting.FileSystemObject").GetFile(Fichier) ' Supprime l'attribut lecture seule: Attributs = ObjFile.Attributes ObjFile.Attributes = 0 ' Une erreur est déclenchée s'il est déjà ouvert: Filenum = FreeFile() Open Fichier For Binary Lock Read Write As #Filenum Close Filenum ' Désactive les macros pour ouvrir le fichier sans lancer "Workbook_Open": If UCase(Right(Fichier, 5)) <> ".XLSX" And DésactiveMacros = True Then Dim secAutomation As MsoAutomationSecurity secAutomation = Application.AutomationSecurity Application.AutomationSecurity = msoAutomationSecurityForceDisable ' Ouvre le fichier (sans mettre à jour les liens si MAJ_Liens=False): Set Wk = Workbooks.Open(Fichier, MAJ_Liens, False, , MotDePasseOuverture, MotDePasseEcriture, True) ' Réactive les macros: Application.AutomationSecurity = secAutomation Else ' Ouvre le fichier (sans mettre à jour les liens si MAJ_Liens=False): Set Wk = Workbooks.Open(Fichier, MAJ_Liens, False, , MotDePasseOuverture, MotDePasseEcriture, True) End If ' Masque le classeur que l'on vient d'ouvrir: Windows(Wk.Name).Visible = Visible ' Restaure l'attribut d'origine: ObjFile.Attributes = Attributs ' Restaure le classeur appelant: Anc_Wk.Activate ' Renvoie le classeur: Set OuvrirClasseur = Wk ' Gestion des erreurs: Gest_Err: Application.ScreenUpdating = Anc_ScreenUpdating If Err.Number <> 0 Then If Not ObjFile Is Nothing Then ObjFile.Attributes = Attributs Err.Raise Err.Number End If End Function '------------------------------------------------------------------------------------------------------ Public Function FermerClasseur(Classeur As Workbook, Enregistrer As Boolean) As Boolean '------------------------------------------------------------------------------------------------------ ' Ferme un classeur (normalement préalablement ouvert avec OuvrirClasseur) et l'enregistre ou non. '------------------------------------------------------------------------------------------------------ ' Classeur : l'objet Workbook à fermer. ' Enregistrer : Vrai s'il faut enregistrer le classeur. '------------------------------------------------------------------------------------------------------ ' Renvoie : VRAI si tout s'est bien passé. '------------------------------------------------------------------------------------------------------ Dim ObjFile As Object Dim Anc_ScreenUpdating As Boolean Dim Attributs As Long ' Gestion des erreurs: On Error GoTo Gest_Err Err.Clear ' Bloque la mise à jour de l'écran: Anc_ScreenUpdating = Application.ScreenUpdating Application.ScreenUpdating = False ' Si le classeur est toujours actif: If TypeName(Classeur) = "Workbook" Then ' S'il faut l'enregistrer: If Enregistrer = True Then ' Une erreur est déclenchée si le fichier source n'est pas trouvé: Set ObjFile = CreateObject("Scripting.FileSystemObject").GetFile(Classeur.FullName) ' Mémorise l'attribut du fichier puis supprime la lecture seule: Attributs = ObjFile.Attributes ObjFile.Attributes = 0 Windows(Classeur.Name).Visible = True Classeur.Activate Application.WindowState = xlMinimized Classeur.Save ' Restaure l'attribut: ObjFile.Attributes = Attributs End If ' Ferme le fichier: Classeur.Saved = True Classeur.Close ' Renvoie Vrai: FermerClasseur = True End If ' Gestion des erreurs: Gest_Err: Application.ScreenUpdating = Anc_ScreenUpdating If Err.Number <> 0 Then Err.Raise Err.Number End Function '------------------------------------------------------------------------------------------------ Public Function TS_RangeDansClasseur(Classeur As Workbook, TS_Nom As String) As Range '------------------------------------------------------------------------------------------------ Dim Ws, Ref For Each Ws In Classeur.Worksheets For Each Ref In Ws.ListObjects If Ref.Name = TS_Nom Then Set TS_RangeDansClasseur = Classeur.Sheets(Ws.Name).Range(TS_Nom): Exit Function End If Next Ref Next Ws Err.Raise vbObjectError, "TS_RangeDansClasseur", "Le tableau [" & TS_Nom & "] n'est pas trouvé dans le classeur " & Classeur.FullName & "." End Function '------------------------------------------------------------------------------------------------ '------------------------------------------------------------------------------------------------
Je mettrai à jour la documentation prochainement.
Salut Laurent,
La feuille d'un tableau structuré s'obtient par la propriété Parent du ListObject. On peut aussi remonter au classeur par le parent du parent.
range("t_Tâches").ListObject.Parent.name renvoie le nom de la feuille qui supporte le tableau.
range("t_Tâches").ListObject.Parent.parent.name renvoie le nom du classeur contenant le tableau.
Et bien sûr, sans le ".Name", on pointe vers la feuille (Parent) ou vers le classeur (Parent.Parent).
Bonjour,
L'approche est intéressante mais ne correspond pas à mon besoin (ou je n'ai pas tout compris):
- la classeur contenant le tableau doit être activé, ce qui nécessite donc ensuite de restaurer le classeur appelant, ce que je ne souhaite pas.
- une erreur est déclenchée quand le classeur est non visible.
Le code que j'ai utilisé :
Code:
1
2
3
4
5
6
7
8
9 Public Function TS_RangeDansClasseur(Classeur As Workbook, TS_Nom As String) As Range Dim Anc_wk As Workbook Dim Feuille As String Set Anc_wk = ActiveWorkbook Classeur.Activate Feuille = Range(TS_Nom).ListObject.Parent.Name Set TS_RangeDansClasseur = Classeur.Sheets(Feuille).Range(TS_Nom) Anc_wk.Activate End Function
Cordialement.
L'erreur est simple (et classique): Référence implicite.Code:Feuille = Range(TS_Nom).ListObject.Parent.Name
Ne serait-ce pas mieux de donner comme argument à la fonction un tableau structuré (ListObject) plutôt qu'un nom ?
voir même se débarrasser de l'argument Workbook, ce qui au final resume la fonction a quelques lignes:
Code:
1
2
3
4
5 Public Function TS_RangeDansClasseur(TS As Excel.ListObject) As Range Debug.Assert Not TS Is Nothing Set TS_RangeDansClasseur = TS.Range End Function
Salut Laurent
Je n'aime vraiment pas cette façon de programmer, donc j'ai du mal à m'y retrouver et à comprendre ce que tes fonctions sont censées réaliser.
Je n'avais pas fait attention que tu travaillais avec un classeur invisible, d'où la proposition de passer par les propriétés Parent.
Je ne comprends pas bien à quoi ça sert, dans un module qui gère des tableaux structurés, d'avoir des fonctions qui ne manipulent pas du tout des tableaux structurés, ceci dit.
De plus, les Exit For dans un For each, perso, je déteste (je déteste tous les Exit). VBA propose Do While qui me semble plus adaptée et qui évite le Exit.
En complément à ma réponse précédente:
Si tu travaille avec des noms, et avec seul objet que le classeur, cela implique de rechercher que l'objet portant le nom donné en argument (donc parcourir toutes les feuilles, bof...).
Sinon, a minima un argument sur la feuille contenant le TS , son nom ou la feuille elle même sera utile.
Ca t'éviteras d'activer un classeur (qui fait coin coin quand il est invisible).
Salut
Pour moi, il n'y a pas d'autre méthode que le parcours des feuilles et des tables des feuilles si l'on veut passer uniquement le nom de la table et du classeur. Or, c'est logique de ne passer que ces arguments puisque le but, c'est justement de récupérer la table uniquement au départ de son nom.
Donc perso, je ne vois pas en quoi c'est bof, puisque c'est, à ma connaissance en tout cas, la seule façon de faire.
@Pierre Fauconnier:
Quid du classeur contenant beaucoup de feuilles, ou beaucoup de tableau ou un mix des 2 ?
Ca reste des cas d'utilisation rare, coté fonctionnement, on peut faire plus optimal.
Ben propose alors 🙄
Mais avec juste le nom de la table et le classeur, je ne vois pas mieux. Or, le but, c'est justement de récupérer la table ou sa plage de données. Du coup, on est bien obligé de parcourir le classeur et ses feuilles. On ne peut pas partir du principe que l'on connait le ListObject puisque le but de la fonction, c'est justement de le récupérer.
Cela dit, parcourir les feuilles d'un classeur et "tous" les tableaux des feuilles, ce n'est quand même jamais très lourd, surtout si on stoppe la boucle dès que l'on a trouvé ce que l'on cherche.
Bonjour,
Une nouvelle version est disponible, avec des corrections et des ajouts, dont une fonction pour chiffrer les données confidentielles d'un tableau (TS_AES au chapitre VII-O) :
Fonctions en VBA pour gérer les Tableaux Structurés d’Excel
Bonne programmation.
Bonjour,
J'apporte ma petite contribution, dans la liste des fonctions ont trouve : TS_EffacerUneLigne et TS_EffacerToutesLignes , mais rien pour effacer une colonne.
J'ai un tableau structuré avec une colonne (peut importe sa position dans le tableau) où je saisie des immatriculations et les autres colonnes j'ai des formules qui vont récupérer des données dans d'autres tableaux (exemple : modèle du véhicule, service où il est affecté, etc..). Problème lorsque je clôture une période de travail, je clique sur un bouton qui me sauvegarde mon tableau et doit après effacer la colonne des immatriculations, mais pas les formules des autres colonnes.
Ce qui était impossible avec les 2 seules fonctions précitées.
Alors ce n'est pas grand chose je ne suis pas de votre niveau, mais je me débrouille :D Alors je vous livre ma fonction TS_EffacerUneColonne
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35 Public Function TS_EffacerUneColonne(TS As Range, ByVal Colonne As Variant) As Boolean '------------------------------------------------------------------------------------------------ ' Efface le contenu d'une colonne dans un Tableau Structuré, mais ne la supprime pas, même si elle est masquée. '------------------------------------------------------------------------------------------------ ' TS : La plage du Tableau Structuré. ' Colonne : La position de la colonne à effacer dans le tableau. ' Si 0 alors efface la dernière colonne du tableau. '------------------------------------------------------------------------------------------------ ' Renvoie : Vrai si l'effacement a été réalisé. '------------------------------------------------------------------------------------------------ ' Gestion des erreurs: On Error GoTo Gest_Err Err.Clear ' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur): Colonne = TS_IndexColonne(TS, Colonne) If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description ' Efface une colonne dans le tableau: TS.ListObject.ListColumns(Colonne).DataBodyRange.Clear TS_EffacerUneColonne = True ' Fin du traitement: Gest_Err: TS_Err_Number = Err.Number TS_Err_Description = Err.Description If Err.Number <> 0 Then If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_EffacerUneColonne", TS_Err_Description If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_EffacerUneColonne" End If Err.Clear End Function
Bonjour,
Merci pour votre intérêt à cette documentation.
Je viens de mettre en ligne une nouvelle version (chapitre II-V) qui reprend la fonction proposée, avec quelques modifications car "ListColumns(Colonne).DataBodyRange.Clear" réagit différemment suivant que le tableau est sur la feuille active ou non : les cellules masquées ne sont pas effacées si le classeur est actif, elles le sont s'il n'est pas actif. La solution de contournement est de masquer la colonne car ainsi les cellules sont toutes effacées dans les deux cas, puis de restaurer la colonne.
Pour n'effacer que les cellules visibles, vous disposez de la fonction "TS_ForcerValeurColonne" en renseignant l'argument "Valeur" avec un vide.
Bonne continuation.