if sous repertoire contient Résolu

Question

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

f894009 · Answer

Bonjour,
Tout a fait Thierry, mais le 19123001  se trouve dans le titre fichier ou...??????????
Pouvez detailler un peu plus?

yanndebretagn · Answer

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

Patrice33740 · Answer

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

yanndebretagn · Answer

bonjour patrice
merci pour le code mais j'ai un erreur "fichier introuvable" sur la ligne 
 If (GetAttr(dossier & sousDos) And vbDirectory) = vbDirectory Then
...

yanndebretagn · Answer

RE
pour dossier:
dossier = "C:\Users\MOI\Documents\ENTREPRISE\devis\"
pour souDos:
sousDos = Dir(dossier, vbDirectory)

yanndebretagn · Answer

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

yanndebretagn · Answer

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

yanndebretagn · Answer

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

yanndebretagn · Answer

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

Patrice33740 · Answer

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

yanndebretagn · Answer

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

f894009 · Answer

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…...

yanndebretagn · Answer

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 RangeDim strChaine As String, firstAddress As StringDim n As Longn = 1strChaine = "*" & Sheets("renseignement client").Range("B23").Value & "*"Set rngTrouve = Sheets("Feuil1").Columns(3).Cells.Find(strChaine, , xlValues, xlWhole)If Not rngTrouve Is Nothing ThenfirstAddress = rngTrouve.AddressDoMsgBox "Trouvé dans la cellule " & rngTrouve.Address(0, 0) & " !"Sheets("renseignement client").Range("D23").Value = Sheets("renseignement client").Range("D23").Value + 1Loop While rngTrouve Is Nothing And rngTrouve.Address <> firstAddressElseMsgBox "Pas trouvé"End IfEnd Sub

Patrice33740 · Answer

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()

yanndebretagn · Answer

pardon 
je voulais dire MsgBox n°devis
et le dernier code que tu m'as donné

yanndebretagn · Answer

non tjrs rien que le numéro du  MsgBox corresponde ou pas a un numéro de devis déjà attribué

Patrice33740 · Answer

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.

yanndebretagn · Answer

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
om&prénom_client\N°devis"
forcément  nom&prénom_client est variable

yanndebretagn · Answer

je ne sais pas a quoi m'attendre 
fait moi rêver f_8

Patrice33740 · Answer

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

yanndebretagn · Answer

bonjour patrice, 
ben non, imaginons que nom_prénom soit en B4
B4 concerne qu'un nouveau client donc 
nomPrenom = Worksheets("renseignement client").Range("B4").Value  
ce n'est pas bon
imaginons que je fais un devis le 04/01/2020 pour monsieur patate qui habite paris 
le devis sera enregistré dans 
C :\Users\MOI\Documents\ENTREPRISE\devis\patate jean-luc\devis n°20010401 monsieur PATATE PARIS
si c'est le premier devis de la journée 
pour  le 2ème  pour monsieur tartempion qui habite Marseille
le devis sera enregistré dans 
C :\Users\MOI\Documents\ENTREPRISE\devis	artempion jean-marie\devis n°20010402 monsieur PATATE Marseille

je ne c pas si c très claire...

Patrice33740 · Answer

Oui, c'est plus clair (avec toujours la même formule en B22) :

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
Dim t() As String
Dim i As Long

  Application.Volatile
  dossier = "C :\Users\MOI\Documents\ENTREPRISE\devis\"
  dossier = ThisWorkbook.Path & "\Tmp\"
  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
  cherche = Format(Date, "yymmdd")
  For i = LBound(t) To UBound(t)
    sousDos = Dir(t(i), vbDirectory)
    Do While sousDos <> ""
      If sousDos <> "." And sousDos <> ".." Then
        If (GetAttr(t(i) & 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
  Next
  NumeroDevis = cherche & Format(maximum + 1, "00")

End Function

yanndebretagn · Answer

l'indice n’appartient pas a la sélection ligne:
  For i = LBound(t) To UBound(t)

yanndebretagn · Answer

bonjour, 
tjrs pas 
la textbox ce lance avec 20010501 marqué dedans qu'il est ou pas un dossier, un sous dossier nommé ou qui contient  déja 20010501 
j'imagine que si C :\Users\MOI\Documents\ENTREPRISE\devis\patate jean-luc\devis n°20010501 monsieur PATATE PARIS existait
la textbox devrait indiqué 20010502
au rage, au désespoir...

yanndebretagn · Answer

MERCI ça marche 
l'espace après le c celui là je l'avais
après c vrai que j'aurai pu virer la ligne 
maintenant je vais essayer d'intégrer le numéro de devis dans b22 automatiquement (tout seul comme un grand)
mille merci patrice pour ta patience et heureux d'avoir croisé ton chemin

If sous repertoire contient - Page 2

Discussions similaires

Newsletters