If sous repertoire contient [Résolu]

Signaler
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020
-
yanndebretagn
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020
-
re le fofo,

Je cherche à faire :
Savoir si dans le dossier C :\Users\MOI\Documents\ENTREPRISE\devis\XYZ \devis n°19123001 monsieur PATATE PARIS CONTIENT 19123001
True
False

SACHANT QUE XYZ PEU ETRE TOUT ET N’IMPORTE QUOI genre YZX
help me

25 réponses

Messages postés
14952
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 janvier 2020
1 210
Bonjour,
Tout a fait Thierry, mais le 19123001 se trouve dans le titre fichier ou...??????????
Pouvez detailler un peu plus?
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020
1
Salut f8

pour être plus précis:
dossier: C :\Users\MOI\Documents\ENTREPRISE\devis\monsieur PATATE\
sous dossier: devis n°19123001 monsieur PATATE PARIS

ce que je cherche à faire:
savoir si le numéro 191230O1 a déjà été attribué sinon le sous dossier aurait le N°+1
soit 191230O2 et ainsi de suite jusqu'au numéro non attribué

voila
bonne fête et à bientôt
Messages postés
7919
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 janvier 2020
1 270
Bonjour,

Exemple :
Option Explicit
Sub Test()
Dim dossier As String
Dim sousDos As String
Dim fichier As String
Dim cherche As String
Dim trouvee As Boolean
Dim t() As String
Dim i As Long

  dossier = "C :\Users\MOI\Documents\ENTREPRISE\devis\"
  cherche = "19123001"
  sousDos = Dir(dossier, vbDirectory)
  Do While sousDos <> ""
    If sousDos <> "." And sousDos <> ".." Then
      If (GetAttr(dossier & sousDos) And vbDirectory) = vbDirectory Then
        i = i + 1
        ReDim Preserve t(1 To i)
        t(i) = dossier & sousDos & "\"
      End If
    End If
    sousDos = Dir
  Loop
  For i = LBound(t) To UBound(t)
    fichier = Dir(t(i))
    Do While fichier <> ""
      If InStr(1, fichier, cherche, vbBinaryCompare) > 0 Then
        trouvee = True
        Exit Do
      End If
      fichier = Dir
    Loop
    If trouvee Then Exit For
  Next i
  If trouvee Then MsgBox fichier

End Sub
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020
1
bonjour patrice
merci pour le code mais j'ai un erreur "fichier introuvable" sur la ligne
 If (GetAttr(dossier & sousDos) And vbDirectory) = vbDirectory Then

...
Patrice33740
Messages postés
7919
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 janvier 2020
1 270
Quelles sont les valeurs de dossier et sousDos quand l'erreur se produit ?
Patrice33740
Messages postés
7919
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 janvier 2020
1 270 > Patrice33740
Messages postés
7919
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 janvier 2020

Il y a une erreur dans le nom de dossier que tu as donné (un espace après le C) corriges par :
  dossier = "C:\Users\MOI\Documents\ENTREPRISE\devis\"
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020
1
RE
pour dossier:
dossier = "C:\Users\MOI\Documents\ENTREPRISE\devis\"

pour souDos:
sousDos = Dir(dossier, vbDirectory)
Patrice33740
Messages postés
7919
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 janvier 2020
1 270
As-tu corrigé le code comme précisé ci dessus ?
Quelle est la valeur de sousDos quand ça plante (pas la ligne de calcul).
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020
1
RE
c'est là que je ne pige pas
il n'y a pas un sous dossier mais un paquet
donc je ne connais pas la valeur de sousdos
...
Patrice33740
Messages postés
7919
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 janvier 2020
1 270
Quand la macro s'arrête, le debogueur indique la ligne en cause, il suffit de passer le curseur sur les varaibles pour connaître leur valeur.
Voir : https://darkvader.developpez.com/tutoriels/vb/debogage-visual-basic-6/#LII-1-5
Et : https://tutoriel-vba.espaceweb.usherbrooke.ca/Documents/VBA%20Excel%20-%20D%C3%A9boguer%20un%20programme%20VBA.pdf

De toutes façons le code fourni devrait fonctionner, la seule ligne qui peut poser problème est celle qui définit le dossier (la 11). il faut que le dossier désigné existe.
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020
1
ok je viens de comprendre
il bloque sur un sous dossier soit disant déplacé ou supprimé mais qui est tjrs présent
donc impossible a virer, ni renommer, ni déplacer
va comprendre
on se revoie (j’espère) l'année prochaine
passer une bonne soirée
Patrice33740
Messages postés
7919
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 janvier 2020
1 270
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020
1
bonjour a tous et tout plein de bonne chose pour cette nouvelle année

concernant mes fichiers litigieux, le problème est réglé,
maintenant la macro ce lance et va jusqu'au bout mais rien ne ce passe, grrrrrrrrrrr!!!!!
si je renseigne en dur un nom de dossier ou sous dossier le problème est identique
la macro ne les détecte pas
Patrice33740
Messages postés
7919
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 janvier 2020
1 270
Avec quel OS ?, Quelle version Excel ?

«si je renseigne en dur un nom de dossier ou sous dossier le problème est identique. la macro ne les détecte pas»
C'est à dire ? Cette macro détecte des fichiers contenus dans les sous-dossiers du dossier spécifié, s'il n'y sont pas, il ne se passe rien.
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020
1
WIN 10 AVEC EXCEL 2007

cherche = "19123001"
- 19123001 représente une partie du nom du sous dossier
- le nom complet est devis n°19123001 monsieur PATATE PARIS
- 19123001 est dans page("renseignement client").cellule("B22")

sauf erreur pour trouver le texte qui ce trouve dans page("renseignement client").cellule("B22") dans l’arborescence je doit faire

cherche = "*" & Sheets("renseignement client").Range("B22").Value & "*"

ou quelque chose comme ça...
Messages postés
7919
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 janvier 2020
1 270
Je croyais que tu cherchais un fichier, pour un sous-dossier c'est plus simple :
Option Explicit
Sub Test()
Dim dossier As String
Dim sousDos As String
Dim cherche As String
Dim trouvee As Boolean

  dossier = "C:\Users\MOI\Documents\ENTREPRISE\devis\"
  cherche = Worksheets("renseignement client").Range("B22").Value
  sousDos = Dir(dossier, vbDirectory)
  Do While sousDos <> ""
    If sousDos <> "." And sousDos <> ".." Then
      If (GetAttr(dossier & sousDos) And vbDirectory) = vbDirectory Then
        If InStr(1, sousDos, cherche, vbBinaryCompare) > 0 Then
          trouvee = True
          Exit Do
        End If
      End If
    End If
    sousDos = Dir
  Loop
  If trouvee Then MsgBox sousDos

End Sub

Cordialement
Patrice

Personne ne peut détenir tout le savoir, c'est pour ça qu'on le partage.
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020
1
mea culpa
je cherche à savoir si le n° devis a déjà été attribué

pour attribuer le n° du devis je passe par la cellule B22
ce qui donne:
aa\mm\jj+n° devis du jour le 02/01/2020
soit pour ce jour devis 1
20010201
et pour ce jour devis 2
20010202

je fais appel à votre contribution pour tester si dans l’arborescence des devis créer il existe un devis nommé 20010201
sinon ajouter +1 à cellule B22 et tester si devis nommé 20010202
si devis 20010202 existe +1 à cellule B22 et tester si devis nommé 20010203
ETC ETC
donc dans l’arborescence ce n'est pas (sous dossier arborescence =B22 ) mais
(sous dossier arborescence CONTIENT B22 )mais ça je gère (je crois)

j’espère que j'ai été plus clair et UN GRAND MERCI (pat) POUR VOTRE AIDE ET PATIENCE
yann
Messages postés
14952
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 janvier 2020
1 210
Bonjour et meilleurx vœux,

Excusez l'incruste svp, je suis de loin votre affaire.

Si vous gérez par numero de devis, et pi tete qu'une simple mise en memoire du dernier num devis serait plus simple ou a la limite memoriser tous les num devis est faire un test si le "nouveau" existe,
De plus, savon pas par quoi ce num est ecrit, a la mano en auto…...
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020
1
Salut f8,
Tjrs content de te lire

Concernant l’établissement de la numérotation des devis je procède comme ça :
EN B19 =AUJOURDHUI()
EN B20 =TEXTE(B19;"aammjj")
EN B21=N° DEVIS attribué manuellement
Et EN B22=CONCATENER(B20; B21)
ce qui donne pour ce jour le 03/01/2020
EN B19 =03/01/2020
EN B20 =200103
EN B21=01 (pour devis 1)
Et EN B22=20010301

Tu dis a la limite memoriser tous les num devis est faire un test si le "nouveau" existe,
C_pivert ma donné un code qui me permet de ressortir l’arborescence du fichier devis dû coup je peux faire une recherche sur la numérotation
Mais j’ai un problème de boucle, je suis obliger de relancer la macro à chaque fois pour quelle retrouve un numéro de devis identique

Sub RECHERCHE()
Dim rngTrouve As Range
Dim strChaine As String, firstAddress As String
Dim n As Long
n = 1


strChaine = "*" & Sheets("renseignement client").Range("B23").Value & "*"
Set rngTrouve = Sheets("Feuil1").Columns(3).Cells.Find(strChaine, , xlValues, xlWhole)
If Not rngTrouve Is Nothing Then
firstAddress = rngTrouve.Address
Do
MsgBox "Trouvé dans la cellule " & rngTrouve.Address(0, 0) & " !"


Sheets("renseignement client").Range("D23").Value = Sheets("renseignement client").Range("D23").Value + 1

Loop While rngTrouve Is Nothing And rngTrouve.Address <> firstAddress


Else
MsgBox "Pas trouvé"
End If
End Sub
Messages postés
7919
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 janvier 2020
1 270
Bonjour et bonne année,

Si tu avais expliqué ça dès le début, on aurait perdu moins de temps
Inutile de lire sur la feuille, VBA calcule ça très bien :
Option Explicit
Sub Test()
Dim n°devis As String
  
  n°devis = NumeroDevis
  MsgBox n°devis
  
End Sub

Private Function NumeroDevis() As String
Dim dossier As String
Dim sousDos As String
Dim cherche As String
Dim n°devis As Integer
Dim maximum As Integer

  dossier = "C :\Users\MOI\Documents\ENTREPRISE\devis\"
  dossier = ThisWorkbook.Path & "\Tmp\"
  cherche = Format(Date, "yymmdd")
  sousDos = Dir(dossier, vbDirectory)
  Do While sousDos <> ""
    If sousDos <> "." And sousDos <> ".." Then
      If (GetAttr(dossier & sousDos) And vbDirectory) = vbDirectory Then
        If sousDos Like "*" & cherche & "??*" Then
          n°devis = Val(Left(Mid(sousDos, InStr(1, sousDos, cherche) + Len(cherche)), 2))
          If n°devis > maximum Then maximum = n°devis
        End If
      End If
    End If
    sousDos = Dir
  Loop
  NumeroDevis = cherche & Format(maximum + 1, "00")

End Function


Et en B22 tu mets directement :
=NumeroDevis()

Cordialement
Patrice

Personne ne peut détenir tout le savoir, c'est pour ça qu'on le partage.
yanndebretagn
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020
1
désolé du tps perdu
bon,ben non
je lance la userforme, elle apparaît avec le numero 20010301
je click et rien
pourtant j'ai bien un devis qui contient 20010301 dans son nom
et le chemin est correct
Patrice33740
Messages postés
7919
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 janvier 2020
1 270 > yanndebretagn
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020

Quelle userform ?
Avec Quel Code ?

Il faut arrêter de donner les infos au compte goutte !!!!
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020
1
pardon
je voulais dire MsgBox n°devis
et le dernier code que tu m'as donné
Patrice33740
Messages postés
7919
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 janvier 2020
1 270
Supprimes la ligne :
dossier = ThisWorkbook.Path & "\Tmp\"
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020
1
non tjrs rien que le numéro du MsgBox corresponde ou pas a un numéro de devis déjà attribué
f894009
Messages postés
14952
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 janvier 2020
1 210
Bonjour,

Je teste pour voir…


Suite:

Code Patrice33740 ok avec sub test
Function Ok avec =NumeroDevis() dans B22

Donc ………….!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Messages postés
7919
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 janvier 2020
1 270
Bonjour le fil,

@ f894009 : Bonne Année et merci pour cette confirmation.

@yanndebretagn : Ça veut dire quoi « toujours rien » ? As-tu compris ce que fait ce code ?

Il fournit automatiquement en B22 le numéro du prochaine devis, en examinant les numéros de devis déjà attribués aujourd'hui et dont le sous-répertoire existe.
B19, B20 et B21 sont devenus totalement inutiles, tu peux les effacer.

Pour que le numéro s'actualise automatiquement à chaque modification de la feuille, tu peux ajoute au début de la fonction (avant la ligne 17) :
  Application.Volatile

Mais, en deux mots, je l'évite car ça mobilise systématiquement des ressources.

Cordialement
Patrice

Personne ne peut détenir tout le savoir, c'est pour ça qu'on le partage.
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020
1
bonjour patrice et f8,

Merci de votre patience (surtout toi patrice)
en faite la macro cherche si dans "C :\Users\MOI\Documents\ENTREPRISE\devis\"
mais il y a encore des sous dossiers avant que le n° de devis apparaisse ce qui donne:
"C :\Users\MOI\Documents\ENTREPRISE\devis\nom&prénom_client\N°devis"
forcément nom&prénom_client est variable
f894009
Messages postés
14952
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 janvier 2020
1 210
Re,
Apres relecture en partant du debut:
Ok , il manque un niveau dans recherche pour le rep nom&prenom qui correspond au XXX du depart de facon a trouver ou pas le rep N°devis
Donc dans le code de Patrice33740 il faut ajouter cette partie. Z'etes chaud bouillant ou pas??
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020
1
je ne sais pas a quoi m'attendre
fait moi rêver f_8
f894009
Messages postés
14952
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 janvier 2020
1 210
Re,

Pour le moment j'ai un soucis sur le premier sousDos=Dir apres avoir le premier sousDos et fait une recherche dans le dit sousDos avec aussi un Dir et pas trouver le rep
Messages postés
7919
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 janvier 2020
1 270
Re,

Je ne vois pas où est la difficulté !
Comme tu ne nous dit pas il trouver Nom & Prènom, j'ai supposé qu'on le trouve en B4 (à toi d'adapter) :
Option Explicit
Sub Test()
Dim n°devis As String
  
  n°devis = NumeroDevis
  MsgBox n°devis
  
End Sub

Private Function NumeroDevis() As String
Dim dossier As String
Dim sousDos As String
Dim nomPrenom As String
Dim cherche As String
Dim n°devis As Integer
Dim maximum As Integer

  Application.Volatile
  nomPrenom = Worksheets("renseignement client").Range("B4").Value
  dossier = "C :\Users\MOI\Documents\ENTREPRISE\devis\" & nomPrenom & "\"
  cherche = Format(Date, "yymmdd")
  sousDos = Dir(dossier, vbDirectory)
  Do While sousDos <> ""
    If sousDos <> "." And sousDos <> ".." Then
      If (GetAttr(dossier & sousDos) And vbDirectory) = vbDirectory Then
        If sousDos Like "*" & cherche & "??*" Then
          n°devis = Val(Left(Mid(sousDos, InStr(1, sousDos, cherche) + Len(cherche)), 2))
          If n°devis > maximum Then maximum = n°devis
        End If
      End If
    End If
    sousDos = Dir
  Loop
  NumeroDevis = cherche & Format(maximum + 1, "00")

End Function


1 2