Les Macros se trainent ! !

[WDAndCo]

Bonsoir le Forum

J'ai un classeur dans le quel il y a une macro qui va voir dans un dossier et reviens avec les noms de tous classeur de ce dossier.
Puis une autre me découpe ses noms pour remplir une base, avec la quelle et un système de filtre (merci BrunoM45) je choisi le bon classeur a ouvrir. Le problème est que la macro qui remplis la base prends un certain temps ! (Il y a pour l’instant que 500 classeurs je pense qu'il en auras 6 fois plus lorsque cela sera opérationnel)

1) Est il possible de la rendre plus rapide ?
2) Je cherche un moyen d'éviter le lancement de cette macro si le nombre de fichier dans le dossier est égal au nombre de nom (MAJ superflue)

Je joint un fichier (les macros sont neutralisées pour éviter de vider la base)

D'avance merci.

 

[Dranreb]

Re : Les Macros se trainent ! !

Ce qui est "absurde", c'est vouloir "imposer" ça façon de faire.

N'ai-je pas commencé ma phrase par "À mon avis" ?

pourquoi vouloir changer ça façon de faire !?

Certes, cela ralenti la mise à jour du tableau, mais au moins les liens sont là

Ben tu donne la réponse avec la question, et ça marche ensuite alors que des liens ne sont pas là, même si on déplace le classeur ailleurs, enfin aucun des em...ements habituels des liens hypertexte.

Cordialement.

 

[WDAndCo]

Re : Les Macros se trainent ! !

Bonsoir le Forum

Je vous remercie, BrunoM45 et Dranreb, et Jean Marie. Je teste cela et je reviens vers vous !

Dominique

 

[WDAndCo]

Re : Les Macros se trainent ! !

Bonsoir le Forum

Merci, et re merci, je trouve que le chargement va dix fois plus vite !

Peut on faire mieux ?

Autre chose peut on récupérer se qui a était choisi pour le filtre ?
J'aimerais mettre un message du genre : "Vous avez choisi (se qui est affiché en colonne A) et (se qui est affiché en colonne B) etc.....

Je joint la dernière version avec vos solutions, avec une macro qui affiche même les colonnes filtres mais en modifiant l’entête.
Merci de me donner vos critiques.

Bonsoir
Dominique

 

[Dranreb]

Re : Les Macros se trainent ! !

Bonjour.
Oui en ajoutant ces déclarations :..., TRésu() As Variant, TSpl() As String, L As Long, C As Long
remplacer ce qui suit votre commentaire "' Transposer le tableau dans la colonne R" par ceci :

  ReDim TRésu(1 To fCount, 1 To 19)
  For L = 1 To fCount
    TSpl = Split(Replace(Mid$(Cells(1 + Ind, "R"), 2), ".xls", "________"), "_")
    For C = 1 To 17: TRésu(L, C) = TSpl(C - 1): Next C
    TRésu(L, 18) = FolderFiles(L)
    TRésu(L, 19) = "Fiche " & L
    Next L
  Cells(2, 1).Resize(fCount, 19).Value = TRésu

Et dans "Feuil1 (Choix)" ajoutez :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> 19 Or Target.Row = 1 Or Target.Count <> 1 Then Exit Sub
Workbooks.Open ThisWorkbook.Path & "\Fiche MP\" & Target.Offset(, -1).Value
End Sub

peut on récupérer se qui a était choisi pour le filtre ?

For Each Flt In Feuil1.AutoFilter.Filters devrait pouvoir être exploité (Dim Flt As Filter). Cherchez dans l'aide.
Pour récupérer en tableau de variant la liste filtrée j'ai ceci:

Sub ValoriserFiltre(TSorti() As Variant, ByVal F As Worksheet)
Dim PlgF As Range, LMax As Long, CMax As Long, Zone As Range, TEntré() As Variant, L As Long, C As Long
Set PlgF = F.AutoFilter.Range
Set PlgF = PlgF.Rows(2).Resize(PlgF.Rows.Count - 1)
Set PlgF = PlgF.SpecialCells(xlCellTypeVisible)
LMax = 0: CMax = PlgF.Columns.Count
For Each Zone In PlgF.Areas
   LMax = LMax + Zone.Rows.Count
   Next Zone
ReDim TSorti(1 To LMax, 1 To CMax) As Variant
LMax = 0
For Each Zone In PlgF.Areas
   TEntré = Zone.Value
   For L = 1 To UBound(TEntré, 1): LMax = LMax + 1
      For C = 1 To CMax: TSorti(LMax, C) = TEntré(L, C): Next C
      Next L
   Next Zone
End Sub

Cordialement.


Bonjour Bruno. Merci pour ce plébiscite.

 

[Compte Supprimé 979]

Re : Les Macros se trainent ! !

Salut Dranreb

J'admire ton art dans la peinture 😉 c'est tellement facile pour toi de faire des tableaux 😀😱

Au plaisir de te lire

 

[Dranreb]

Re : Les Macros se trainent ! !

Ah, j'ai oublié de rectifier une instruction d'origine, c'est :

TSpl = Split(Replace(FolderFiles(L), ".xls", "________"), "_")

Embarassant qu'on ne puisse aisément tester, car on n'a évidemment pas de tels fichiers.
À +

 

[ChTi160]

Re : Les Macros se trainent ! !

Bonjour Dominique
Bonjour le Fil
Bonjour Le Forum

Arff Effectivement Dominique aurait pu mettre un fichier en exemple avec quelques données ,car je n'arrive pas a tester donc je ne fait rien , cela n'a pas empêché les participants a ce fil de faire du très bon boulot (que je ne peux tester Lol)
Bonne Journée
Amicalement
Jean marie

 

[WDAndCo]

Re : Les Macros se trainent ! !

Bonsoir le Forum, alors là pour ramoner sa ramone ! ! ! J'ai rien compris mais cela fonctionne.
J'ai rajouté cela

Dim L&, C&, TSpl

Dans le tableau les colonnes sont décalés d'un vers la droite il y a rien en A se qui devrait être en A est en B et ainsi de suite, cela est surement du au faite que les noms commence par _
J'ai quand même compris (mais pas tout de suite) que les liens ne servent plus !)

 ' Transposer le tableau dans la colonne R
  Dim L&, C&, TSpl
  
  ReDim Trésu(1 To fCount, 1 To 19)
  For L = 1 To fCount
   TSpl = Split(Replace(FolderFiles(L), ".xls", "________"), "_")
    For C = 1 To 17: Trésu(L, C) = TSpl(C - 1): Next C
    Trésu(L, 18) = FolderFiles(L)
    Trésu(L, 19) = "Fiche " & L
    Next L
  Cells(2, 1).Resize(fCount, 19).Value = Trésu
  
  ' Boucle pour le remplisage des colonnes de A à Q
  'For Ind = 1 To UBound(FolderFiles)
    'Cells(1 + Ind, 1).Resize(, 17) = Split(Replace(Mid$(Cells(1 + Ind, "R"), 2), ".xls", "________"), "_")
  'Next Ind
  ' Boucle pour les liens
  'For Ind = 1 To UBound(FolderFiles)
    'Cells(Ind + 1, 19).Hyperlinks.Add Anchor:=Cells(Ind + 1, 19), Address:= _
      'sPath & Cells(Ind + 1, 18), TextToDisplay:="Fiche " & Ind
  'Next Ind
  
  Cells(1, 28).Value = L - 1 'Le Nombre de Fichier en AB1

De plus au sujet du 3eme code alors la, le noir absolu ! ! Je ne sais même pas ou le mettre, ni comment cela doit se déclenché ! ! Il y a des cracks sur ce Forum. La je suis sur le c-l ! !

Pour Jean-Marie les classeurs ouvert avec ce classeur ne sont que des feuilles de maintenance, un dessin, un tableau à remplir une fois par an ! Mais il y en a une multitude voici l’intérêt de ce classeur.

Encore merci
Bonsoir
Dominique

 

[ChTi160]

Re : Les Macros se trainent ! !

Re Domnique

je pense que ton problème de décalage vient de l'initialisation de ton Tableau (Option Base 1 Or Not) Si Option Base 1 le tableau commence a l'indice 1 alors que si cette option n'est pas définie le tableau Commence à 0
je n'ai pas encore teste le fichier mais je pense que Danred va te modifier cela
s'il peut par la même , m'expliquer comment tester ces procédures ??? Merci par avance
Bonne fin de Soirée
Amicalement
Jean Marie

 

[Brigitte]

Re : Les Macros se trainent ! !

Bonsoir le fil,

Une petite incruste pour saluer la présence de jean marie (alias chti160, alias tchouchou sans tchouchou ;-).
J'espère que tu vas bien... Bisous

 

[ChTi160]

Re : Les Macros se trainent ! !

Bonsoir Brigitte
arfff je ne peux m'empêcher de venir voir le forum

Oui tchouchou et toujours tchouchou mais sans tchouchou

j'espère que ta petite famille va bien
Merci de ton intervention sur ce Fil
Merci aussi pour ce que tu fais toujours pour ce Site

Bisous
Amicalement Chti160

 

[Dranreb]

Re : Les Macros se trainent ! !

Le 3ième code permet de récupérer le contenu d'une table filtrée dans un tableau de variant, mais sans que cela n'indique en rien sur quoi elle a été filtrée (pour ce dernier point je n'ai pas d'exemple, j'ai juste indiqué où il fallait chercher).
Je l'ai donnée à tout hasard parce que ça peut servir à l'occasion. Elle se met dans un module ordinaire et peut s'appeler depuis n'importe quel module. Syntaxe :

ValoriserFiltre TSorti, F

TSorti: Le tableau de variant à garnir (déclaré: Dim TSorti() As Variant)
F: l'objet Worksheet dont on veut extraire la liste filtrée (il ne peut y en avoir qu'une dans une feuille, et on sait toujours où elle est). Appelé depuis le module de la feuille concernée spécifiez comme second paramètre Me, sinon de préférence un CodeName de feuille, au pire ActiveSheet.
À +

 

[WDAndCo]

Re : Les Macros se trainent ! !

Bonjour le Forum

J'ai trouvé pour le décalage il y a :

For C = 1 To 17: Trésu(L, C) = TSpl(C - 1): Next C

Il faut :

For C = 1 To 17: Trésu(L, C) = TSpl(C): Next C

Un autre petit truc si j'ai 500 classeurs et que je clic dans le cellule S502 j'ai un message d’erreur.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> 19 Or Target.Row = 1 Or Target.Count <> 1 Then Exit Sub
Workbooks.Open ThisWorkbook.Path & "\Fiche MP\" & Target.Offset(, -1).Value
End Sub

Je suppose que c'est dans ce code qu'il faut limiter les actions de la colonne S

Je vous remercie encore tous !
Bon dimanche
Dominique

 

[Dranreb]

Re : Les Macros se trainent ! !

Bonjour
Pour le 1er point: curieux ! Car la fonction Split renvoie toujours un tableau commençant à 0. Ça voudrait dire qu'on ne doit pas tenir compte du 1er mot, où qu'il est vide si ça commence par "_".
Deuxième point, oui bien sûr ce n'était qu'une ébauche. Étoffons la un peu :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim NomFic As String
If Target.Column <> 19 Or Target.Row = 1 Or Target.Count <> 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
NomFic = Target.Offset(, -1).Value
On Error Resume Next
Workbooks(NomFic).Activate ' car il peut déjà avoir été ouvert
If Err Then Err.Clear: Workbooks.Open ThisWorkbook.Path & "\Fiche MP\" & NomFic
If Err Then MsgBox "Ouverture impossible de """ & NomFic & """ dans" & vbLf _
   & ThisWorkbook.Path & "\Fiche MP", vbCritical, "Applel " & Target.Value
End Sub

P.S. Corrigé pour éviter d'interroger Target.Value avant d'être sûr qu'il ne s'agit que d'une seule cellule

Cordialement

 

[WDAndCo]

Re : Les Macros se trainent ! !

Bonjour le Forum

Je vous confirme que tous les noms de classeur commencent par "_" et que le fait d'avoir ôté le -1 tout est remis dans la bonne colonne !

Avec le nouveau code lorsque je clic sur une cellule vide de la colonne S rien ne se passe ! Pas de message :

If Err Then MsgBox "Ouverture impossible de """ & NomFic & """ dans" & vbLf _
   & ThisWorkbook.Path & "\Fiche MP", vbCritical, "Applel " & Target.Value

Par contre lors d'un clic dans une cellule non vide de la colonne S j'ai ce message d'erreur :


Et cela dans le code :


[edit]Une précision j'ai cela sur toutes les cellules de ce classeur :

qui fait office de simili protection ![/edit]

C'est grave Docteur ?

Dominique