Discussion :

[Valtrase]

Salut,
Allez avant d'aller au lit

- Tu as mis une formule sur le Bouton "Lancer la recherche"

Ce n'est pas moi c'est Excel ou plutôt vous deux tu as mis un bouton ActiveX? donc Excel ajoute cette Valeur (QUE TU NE DOIT PAS TOUCHER)

Par contre, est-il possible de revenir sur un N° de prix et d'avoir ce que l'on avait déjà coché avec les qtés et du coup en effaçant uniquement le N° de prix correspondant ?

Là j'avoue ne pas trop comprendre la question, j'ai fait une modification qui reprends des éléments et des prix favoris regardes si cela te va.

[scoobydoos]

Salut,
Allez avant d'aller au lit

Ce n'est pas moi c'est Excel ou plutôt vous deux tu as mis un bouton ActiveX? donc Excel ajoute cette Valeur (QUE TU NE DOIT PAS TOUCHER)


Là j'avoue ne pas trop comprendre la question, j'ai fait une modification qui reprends des éléments et des prix favoris regardes si cela te va.

Salut,

Ah ok. Bon je touches pas alors...

En fait, dans un premier temps, je choisis une première fois mon matériel. Ca fonctionne bien, je peux cocher ce que je veux et mettre les quantités et je valides et cela met tout dans un tableau de consultation. Pas de soucis jusque là. Mais si je me dis, tiens j'ai oublié de mettre un matériel, je resélectionnes mon N° de prix, j'aimerai retrouver ce que j'ai mis avec les quantités mais aussi voir le reste de la liste.
Je ne sais pas si c'est plus clair

En plus, il ne faudrait pas que cela efface les autres. Là je penses que c'est un plus compliqué.

Et je me suis dis que si on rajoute une autre colonne avec "N° de prix" dans le tableau "Consultation", on pourrai faire une recherche plus facilement.

Merci par avance
@+

Essai LISTVIEW 3.xlsm

[Valtrase]

Salut,
As-tu tester le fichier dans mon dernier post ?

[scoobydoos]

Salut,
As-tu tester le fichier dans mon dernier post ?

Salut,

Oui excuses moi, j'avais pas pris le bon fichier

J'ai testé ton fichier. Ok cela reprend bien les quantités avec le matériel coché nickel.

Par contre, j'ai un soucis car pour chaque N° de prix, j'ai parfois les mêmes références qui reviennent et lorsque je valides, ça ne prend pas en compte les matériels du N° de Prix.

J'ai remis dans le "Userform Initialize" la recherche en gras pour trouver le N°de prix :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
For Each Ele In Worksheets("BDD").Range("TBDD[Type prix]")
            If UCase(Ele) = UCase(Range("r_SearchTypePrix")) Then    ' // On recherche le type de prix
                Set lstRow = lstObj.ListRows(Ele.Row - 1)   ' // On retire 1 car nous avons des entêtes dans le tableau
                With Me.ListView1
                    Set lstVRow = .ListItems.Add(, , "0")    ' // On instentie une nouvelle ligne on renseigne 0 pour la quantité par défaut

                    With lstVRow
                        ' // On rempli les colonnes de la nouvelle ligne
                        .ListSubItems.Add , , lstRow.Range(2)
                        .ListSubItems.Add , , lstRow.Range(3)
                        .ListSubItems.Add , , lstRow.Range(4)
                        .Checked = lstRow.Range(5) = True
                        .Text = lstRow.Range(6).value
                    End With
                End With
            End If

Mais ça ne prend pas !

Merci par avance
@+

[Valtrase]

Salut,

If UCase(Ele) = UCase(Range("r_SearchTypePrix")) Then ' // On recherche le type de prix

Comme tu peux le constater on fait la comparaison de chaque élément de la colonne N° Prix avec un Champ Nommé, donc il faut dans un premier temps que ce champ existe et qu'il soit renseigné.

Par contre, j'ai un soucis car pour chaque N° de prix, j'ai parfois les mêmes références qui reviennent et lorsque je valides, ça ne prend pas en compte les matériels du N° de Prix.

Pour faire cela je rajoute une colonne index sur le tableau (Qui devrait être toujours présente sur des tableaux de données), et au chargement des lignes dans le listview je sauvegarde l'Index dans la propriété Tag de la ligne.
Reste plus qu'a utiliser la propriété Tag pour écrire dans la bonne ligne du tableau de datas

[scoobydoos]

Salut,

Comme tu peux le constater on fait la comparaison de chaque élément de la colonne N° Prix avec un Champ Nommé, donc il faut dans un premier temps que ce champ existe et qu'il soit renseigné.


Pour faire cela je rajoute une colonne index sur le tableau (Qui devrait être toujours présente sur des tableaux de données), et au chargement des lignes dans le listview je sauvegarde l'Index dans la propriété Tag de la ligne.
Reste plus qu'a utiliser la propriété Tag pour écrire dans la bonne ligne du tableau de datas

Salut,

Ok j'ai compris. Par contre, je ne comprends pas quand je veux changer ma sélection et les quantités, cela écrit bien dans le tableau "Consultation" mais ça ne change pas les valeurs dans le tableau BDD alors qu'il y a bien ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
With Worksheets("BDD").Range("TBDD").ListObject.ListRows(CLng(UserForm1.ListView1.ListItems(lngCounter).Tag))
                              .Range(5).value = True
                              .Range(6).value = UserForm1.ListView1.ListItems(lngCounter).Text
                              End With

37 F.67 Legrand 410499 Bloc diff adaptable à vis DX³ pour disj 1 module/pôle 4P 40A typeAC 30mA VRAI 6
38 F.67 Legrand 411966 Interrupteur différentiel DX³-ID vis - 4P 40A TypeB 30mA - 4 modules VRAI 1
39 F.67 Legrand 409359 Disjoncteur DX310000 16kA arrivee haut-depart bas vis 4P 40A courbe C 4 modules VRAI 1
40 F.67 Legrand 409086 Disjoncteur DX310000 16kA arrivee haute-depart bas vis 4P 40A courbe B - 4 mod VRAI 5
41 F.67 Schneider A9P71740 Acti9 iDT40K - disjoncteur modulaire - 3P+N - 40A - courbe C - 4500A/4,5kA VRAI 1

Alors que le tableau consultation est bien à jour :
Legrand 410499 Bloc diff adaptable à vis DX³ pour disj 1 module/pôle 4P 40A typeAC 30mA 6
Legrand 409086 Disjoncteur DX310000 16kA arrivee haute-depart bas vis 4P 40A courbe B - 4 mod 5
Schneider A9P71740 Acti9 iDT40K - disjoncteur modulaire - 3P+N - 40A - courbe C - 4500A/4,5kA 1

Je ne vois pas le pb car il y a bien le tag...

Merci par avance
@+

[scoobydoos]

Salut Valtrase,

J'ai un autre soucis que je ne comprends pas. Dans le code ci-dessous :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Private Sub ListView1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim lngCounter
    With Me.ListView1
        For lngCounter = 1 To .ListItems.Count
            If CLng(.ListItems(lngCounter).Text) <> 0 Then 'Ca me bloque ici ???
                .SetFocus
                .ListItems(lngCounter).Selected = True
            End If
        Next lngCounter
    End With
End Sub

Merci par avance
@+

[scoobydoos]

Bah, j'ai compris, il fallait que je mettes les 0 dans la colonne et FAUX dans l'autre

Par contre, j'ai fait la même chose dans mon fichier et cela n'écrit pas ni dans le tableau "TBaseOTI" et ni dans "Consultations" !!

Je ne vois pas où cela bloque.

Peux-tu regarder mon fichier ci-dessous ?

Il y a aussi le pb de réécriture dans le tableau "TBaseOTI" où les qtés ne se mettent pas à jour et ni "FAUX" et "VRAI".... ça m'énerve de ne pas trouver....

BPU.xlsm

Merci par avance
@+

[Valtrase]

Salut,
J'ai fait un peu le ménage, maintenant tu peux :

• Cocher une ligne, ce qui va la sélectionner et mettre 1 par défaut sur la quantité
• Double-cliquer sur une ligne, ce qui va sélectionner et mettre la zone quantité en mode édition (La touche Entrer ne valide pas bien la saisie, cliquez sur une autre ligne pour valider)

Je pense avoir résolu tes autres problèmes.

Voili voilou bonne prog

[scoobydoos]

Salut,
J'ai fait un peu le ménage, maintenant tu peux :

• Cocher une ligne, ce qui va la sélectionner et mettre 1 par défaut sur la quantité
• Double-cliquer sur une ligne, ce qui va sélectionner et mettre la zone quantité en mode édition (La touche Entrer ne valide pas bien la saisie, cliquez sur une autre ligne pour valider)

Je pense avoir résolu tes autres problèmes.

Voili voilou bonne prog

Salut Valtrase,

Super ! Merci beaucoup... Bon tu m'as un peu perdu lorsque j'ai regardé le code mais j'ai retrouvé à peut près mes petits

Par contre, je n'arrives pas à trouver ce qui efface le tableau car je voulais que chaque N° de prix apparaisse dans le tableau de consultations à la suite. Par contre, je ne sais pas comment faire si je modifie un N° de Prix, est-ce que ça efface tout le reste ?

Est-ce là ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Else    ' // Si pas trouvé alors on réinitialise la ligne
                            lstRow.Range(6).Value = False
                            lstRow.Range(7).Value = 0
                        End If

Il y a une erreur aussi sur l'USF ? Qu'est-ce ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Dim usf As New UserForm1
With usf
        .Caption = "Résultats pour la recherche de : " & Worksheets("Devis").Range("r_SearchTypePrix").Value
        .Show
    End With

Merci par avance
@+

[scoobydoos]

Re,

Ok j'ai trouvé l'effacement du tableau

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
With Worksheets("Consultations").Range("TConsult").ListObject
        If .ListRows.Count > 0 Then
            .DataBodyRange.Delete    ' // On efface le tableau
        End If
    End With

Je ne sais pas pourquoi tout à coup cela me fait une erreur de débogage !!



Sur le USF (UserForm1) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
With UsF
        .Caption = "Résultats pour la recherche de : " & Worksheets("Devis").Range("r_SearchTypePrix").Value
        .Show
    End With

Il met : "USF = <Variable objet ou variable de bloc With non définie>". Bizarre... Sais-tu d'où cela vient ?

BPU Total vf.xlsm

Merci par avance
@+

[scoobydoos]

Salut Valtrase,

Ben je sèches, je ne trouves pas pourquoi j'ai cette erreur car les variables sont bien définies...

En plus, ton fichier fonctionne et pas le mien

Merci pour ton aide

@+

[Valtrase]

Salut,
C'est sûrement à l'initialisation du formulaire que cela bloque, tu as du changer le nom d'une colonne, ou son emplacement donc le mieux c'est la touche F8
Alors dans l'ordre :

• Dans la Sub UserForm_Initialize()
  
  • Tu mets le curseur sur la ligne Call CreateColumnHeaders ' // Création des colonnes d'entêtes et tu lui colles un point d'arrêt touche F9.
  
  
• Ensuite tu lances le formulaire par ton bouton
• Sur le point d'arrêt tu fais du pas à pas avec la touche F8, ça peut être long

Un conseil si pas d'erreur tu colles, par-ci par-là, des points d'arrêt, cela te permettras d'y revenir plus vite.
Tu peux aussi ajouter des espions express en sélectionnant une expression et en appuyant sur les touches MAJ F9.

Bonne prog.

ps: Petit changements j'ai ajouté une option pour ne pas effacer le tableau sur le formulaire.

Oupssss petite boulette...
Dans le code de la feuille Devis change le True en False

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
    With Worksheets("Consultations").Range("TConsult").ListObject
        If .ListRows.Count > 0 And Worksheets("xl_Paramètres").Range("xltr_TableauConsultErase").Value = False Then
            .DataBodyRange.Delete    ' // On efface le tableau
       End If
   End With

[scoobydoos]

Salut,
C'est sûrement à l'initialisation du formulaire que cela bloque, tu as du changer le nom d'une colonne, ou son emplacement donc le mieux c'est la touche F8
Alors dans l'ordre :

• Dans la Sub UserForm_Initialize()
  
  • Tu mets le curseur sur la ligne Call CreateColumnHeaders ' // Création des colonnes d'entêtes et tu lui colles un point d'arrêt touche F9.
  
  
• Ensuite tu lances le formulaire par ton bouton
• Sur le point d'arrêt tu fais du pas à pas avec la touche F8, ça peut être long

Un conseil si pas d'erreur tu colles, par-ci par-là, des points d'arrêt, cela te permettras d'y revenir plus vite.
Tu peux aussi ajouter des espions express en sélectionnant une expression et en appuyant sur les touches MAJ F9.

Bonne prog.

ps: Petit changements j'ai ajouté une option pour ne pas effacer le tableau sur le formulaire.

Oupssss petite boulette...
Dans le code de la feuille Devis change le True en False

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
    With Worksheets("Consultations").Range("TConsult").ListObject
        If .ListRows.Count > 0 And Worksheets("xl_Paramètres").Range("xltr_TableauConsultErase").Value = False Then
            .DataBodyRange.Delete    ' // On efface le tableau
       End If
   End With

Salut Valtrase,

Ok c'est vrai, tu avais raison, je n'avais pas vu que les noms des colonnes avaient changé. Donc cela refonctionne, nickel champion !

Le tableau consultations ne s'efface pas lorsque je remplie mes N° de prix. Ca s'est ok aussi. Par contre, est-il possible d'ajouter dans ce tableau le N° d'ID ? Car si je veux modifier un N° de Prix, cela incrémente le tableau et me fait des doublons ?

Merci encore pour ton temps

Merci par avance
@+

[Valtrase]

Salut,

Par contre, est-il possible d'ajouter dans ce tableau le N° d'ID ? Car si je veux modifier un N° de Prix, cela incrémente le tableau et me fait des doublons ?

J'ai fait des modifications et ajouté une fonction qui est très bien pour les tableaux structurés. Je pense être au résultat attendu...
J'ai aussi changé les références des champs nommés pour les basculer dans la feuille paramètres.

[scoobydoos]

Salut,

J'ai fait des modifications et ajouté une fonction qui est très bien pour les tableaux structurés. Je pense être au résultat attendu...
J'ai aussi changé les références des champs nommés pour les basculer dans la feuille paramètres.

Salut Valtrase,

Je te remercie infiniment pour ton aide. Le fichier fonctionne parfaitement.

J'ai encore cependant quelques amélioration à faire
J'ai suivi le blog de Pierre Fauconnier sur les chemins des répertoires : https://www.developpez.net/forums/bl...el-fonction-4/
Cela fonctionne bien pour les fichiers dans un même répertoire avec le code ci-dessous :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=GAUCHE(CELLULE("nomfichier");TROUVE("[";CELLULE("nomfichier"))-2)

Et dans le Power Query :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Chemin=Table.FirstValue(Excel.CurrentWorkbook(){[Name="Chemin"]}[Content]),
    Source = Excel.Workbook(File.Contents(Chemin & "\BPU_OV_Entreprise_Site_Juillet 2022.xlsx"), null, true),

En fait, je reprends mes explications :
- J'ai 2 fichiers dans un même répertoire :
* Un fichier BPUxxxxx.xls
* Un fichier Devis BPU.xlsx

Je commences par remplir le 1er fichier. Une fois, je travailles avec le 2ième (celui sur lequel on a travaillé depuis quelques jours). Donc le chemin fonctionne pour trouver le fichier BPU.
Cependant, mes collègues changent le nom du fichier BPUquelqueschoses.xlsx. Je voudrais que cela recherche le fichier avec "BPU" dedans.

J'ai trouvé comment avoir juste BPU du fichier :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=STXT(CELLULE("nomfichier";A1);CHERCHE("]";CELLULE("nomfichier";A1))+1;3)

Par contre, je ne sais pas l'intégrer pour qu'il cherche le chemin et le fichier.

Et je voudrais faire pareil pour trouver les fichiers dans le répertoire \BDD.

Merci par avance
@+

[Valtrase]

Salut,

=STXT(CELLULE("nomfichier";A1);CHERCHE("]";CELLULE("nomfichier";A1))+1;3)

Attention, quand tu entre cette formule tu retournes les trois premières lettre de la page ou tu as mis la formule et non celles du fichier. tu dois donc changer le "]" par "[" sinon tu risques d'avoir des erreurs.

Par contre, je ne sais pas l'intégrer pour qu'il cherche le chemin et le fichier.

Là je ne comprends pas la question...

Concernant la recherche de "BPU" tu peux utiliser l'opérateur LIKE

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Public Function TestLike(strTemp As String)
    TestLike = strTemp Like "*BPU*.xlsm"
End Function

Pour t'aider il va falloir être plus explicite, je pense

[scoobydoos]

Salut,

Attention, quand tu entre cette formule tu retournes les trois premières lettre de la page ou tu as mis la formule et non celles du fichier. tu dois donc changer le "]" par "[" sinon tu risques d'avoir des erreurs.


Là je ne comprends pas la question...

Concernant la recherche de "BPU" tu peux utiliser l'opérateur LIKE

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Public Function TestLike(strTemp As String)
    TestLike = strTemp Like "*BPU*.xlsm"
End Function

Pour t'aider il va falloir être plus explicite, je pense

Salut Valtrase,

Je vais essayer d'être plus explicite

A chaque affaire donc 1 répertoire par affaire, j'ai mes 2 fichiers :
- Devis BPU (sur lequel on a bossé)
- BPUnomaffaire

Ma BDD est normalement toujours au même endroit et dans le même répertoire. Le soucis, c'est que mes collègues utilisent le cloud et le chemin d'accès est par rapport au nom soit c:\user\nomdelapersonne\nexcloud\Affaire1. Donc il change selon la personne qui utilise les fichiers Devis et BPU.

Donc il faut que pour la BDD, cela recherche le répertoire où se trouve les fichiers de la base de données et que dans le répertoire où j'ai mes 2 fichiers, il faut que le fichier Devis BPU trouve le fichier BPUquelquechose.

Aujourd'hui, j'ai mis le vrai nom en entier mais si ils renomment celui-là, ça va pas fonctionner.

Est-ce plus clair ?

Merci par avance
@+

[Valtrase]

Salut,
Dans les faits c'est pas très compliqué si l'on a les bons outils...
Voici un fonction pour récupérer le chemin de OneDrive

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
'————————   ENUMERATION POUR DOSSIER ONEDRIVE   ———————————————————————————————————————————————————————————————————————
Public Enum vaEnvironType
    AllUsersProfile = 1
    ApplicationData = 2
    CommonProgramFiles = 3
    CommonProgramFiles_x86 = 4
    CommonProgramW6432 = 5
    ComputerName = 6
    ComSpec = 7
    DriverData = 8
    FPS_BROWSER_APP_PROFILE_STRING = 9
    FPS_BROWSER_USER_PROFILE_STRING = 10
    HomeDrive = 11
    InstalledOS = 19
    OneDrive = 16
    OneDriveCommercial = 17
    OneDriveConsumer = 18
    ProgramFiles = 28
    ProgramFiles_x86 = 29
    ProgramW6432 = 30
    SystemDrive = 34
    SystemRoot = 35
    Temp = 36
    Tmp = 37
    UserDomain = 38
    UserName = 40
    UserProfile = 41
    Windir = 42
End Enum
 
' // GetEnvironType By Jean-Paul (Valtrase) le : 20/06/2019
' // Renvoie le chemin de la variable passée en paramètre si elle existe sinon une chaine nulle. Nécessite L'Enum vaEnvironType.
Public Function GetEnvironType(Optional EnvironType As vaEnvironType) As String
    Dim strEnvironType As String, strTemp As String
    '// On récupère la chaine complète
    strTemp = Environ(CInt(EnvironType))
    If strTemp <> "" Then
        'strTemp = Right(strTemp, Len(strTemp) - InStr(1, strTemp, "=", vbTextCompare))
        strTemp = Split(strTemp, "=", , vbTextCompare)(1)
        GetEnvironType = strTemp & "\"
    Else
        GetEnvironType = vbNullString
    End If
 End Function

Ensuite une fonction qui ajoute Le BackSlash en fin de chemin:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
' // AddBackslash By Jean-Paul (Valtrase) le : 19/10/2016
' // Ajoute un backSlash à la fin du chemin si nécessaire
Public Function AddBackslash(ByVal FolderPath As String) As String
    FolderPath = Trim(FolderPath)
    If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
    AddBackslash = FolderPath
End Function

Et pour finir lafonction qui gère tout cela

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
' // GetIfExistAndOpenFile By Jean-Paul (Valtrase) le : 14/10/2022
' // Recherche un fichier dans le répertoire OneDrive et dont le nom commence par BPU
Function GetIfExistAndOpenFile(Path As String, Optional Value As String = "BPU", Optional WithMacro As Boolean = True, Optional AutoOpen As Boolean = True) As String
    Dim strTemp As String
    Dim strFileName As String
    Dim strFullPath As String
 
    strTemp = AddBackslash(GetEnvironType(OneDrive))
    Path = AddBackslash(Path)
    If Left(Path, 1) = "\" Then Path = Mid(Path, 2)    ' // si un slash en début on supprime
    If strTemp > "" Then
        strFileName = Dir(strTemp & Path & Value & "*" & IIf(WithMacro = True, ".xlsm", "xls"))
    End If
    If strFileName > "" Then
        strFullPath = strTemp & AddBackslash(Path) & strFileName
        If AutoOpen Then Workbooks.Open strFullPath
        GetIfExistAndOpenFile = strFullPath
    Else
        GetIfExistAndOpenFile = ""
    End If
End Function

Pour faire ta recherche tu dois renseigner :

• Renseigner Path qui est le ou les sous-dossiers de OneDrive ("Affaires BPU\Toulouse")
• Renseigner Value ou pas, la valeur à rechercher qui par défaut est "BPU"
• Renseigner ou pas, WithMacro qui par défaut est "xlsm"
• Renseigner ou pas, AutoOpen si l'on veut lancer le classeur ou juste récupérer le chemin

Pour l'exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
MsgBox GetIfExistAndOpenFile("Affaire 1\)

Voilà je pense être bon la fonction GetIfExistAndOpenFile peut être encore améliorée...
Bonne prog

[scoobydoos]

Salut,
Dans les faits c'est pas très compliqué si l'on a les bons outils...
Voici un fonction pour récupérer le chemin de OneDrive

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
'————————   ENUMERATION POUR DOSSIER ONEDRIVE   ———————————————————————————————————————————————————————————————————————
Public Enum vaEnvironType
    AllUsersProfile = 1
    ApplicationData = 2
    CommonProgramFiles = 3
    CommonProgramFiles_x86 = 4
    CommonProgramW6432 = 5
    ComputerName = 6
    ComSpec = 7
    DriverData = 8
    FPS_BROWSER_APP_PROFILE_STRING = 9
    FPS_BROWSER_USER_PROFILE_STRING = 10
    HomeDrive = 11
    InstalledOS = 19
    OneDrive = 16
    OneDriveCommercial = 17
    OneDriveConsumer = 18
    ProgramFiles = 28
    ProgramFiles_x86 = 29
    ProgramW6432 = 30
    SystemDrive = 34
    SystemRoot = 35
    Temp = 36
    Tmp = 37
    UserDomain = 38
    UserName = 40
    UserProfile = 41
    Windir = 42
End Enum
 
' // GetEnvironType By Jean-Paul (Valtrase) le : 20/06/2019
' // Renvoie le chemin de la variable passée en paramètre si elle existe sinon une chaine nulle. Nécessite L'Enum vaEnvironType.
Public Function GetEnvironType(Optional EnvironType As vaEnvironType) As String
    Dim strEnvironType As String, strTemp As String
    '// On récupère la chaine complète
    strTemp = Environ(CInt(EnvironType))
    If strTemp <> "" Then
        'strTemp = Right(strTemp, Len(strTemp) - InStr(1, strTemp, "=", vbTextCompare))
        strTemp = Split(strTemp, "=", , vbTextCompare)(1)
        GetEnvironType = strTemp & "\"
    Else
        GetEnvironType = vbNullString
    End If
 End Function

Ensuite une fonction qui ajoute Le BackSlash en fin de chemin:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
' // AddBackslash By Jean-Paul (Valtrase) le : 19/10/2016
' // Ajoute un backSlash à la fin du chemin si nécessaire
Public Function AddBackslash(ByVal FolderPath As String) As String
    FolderPath = Trim(FolderPath)
    If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
    AddBackslash = FolderPath
End Function

Et pour finir lafonction qui gère tout cela

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
' // GetIfExistAndOpenFile By Jean-Paul (Valtrase) le : 14/10/2022
' // Recherche un fichier dans le répertoire OneDrive et dont le nom commence par BPU
Function GetIfExistAndOpenFile(Path As String, Optional Value As String = "BPU", Optional WithMacro As Boolean = True, Optional AutoOpen As Boolean = True) As String
    Dim strTemp As String
    Dim strFileName As String
    Dim strFullPath As String
 
    strTemp = AddBackslash(GetEnvironType(OneDrive))
    Path = AddBackslash(Path)
    If Left(Path, 1) = "\" Then Path = Mid(Path, 2)    ' // si un slash en début on supprime
    If strTemp > "" Then
        strFileName = Dir(strTemp & Path & Value & "*" & IIf(WithMacro = True, ".xlsm", "xls"))
    End If
    If strFileName > "" Then
        strFullPath = strTemp & AddBackslash(Path) & strFileName
        If AutoOpen Then Workbooks.Open strFullPath
        GetIfExistAndOpenFile = strFullPath
    Else
        GetIfExistAndOpenFile = ""
    End If
End Function

Pour faire ta recherche tu dois renseigner :

• Renseigner Path qui est le ou les sous-dossiers de OneDrive ("Affaires BPU\Toulouse")
• Renseigner Value ou pas, la valeur à rechercher qui par défaut est "BPU"
• Renseigner ou pas, WithMacro qui par défaut est "xlsm"
• Renseigner ou pas, AutoOpen si l'on veut lancer le classeur ou juste récupérer le chemin

Pour l'exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
MsgBox GetIfExistAndOpenFile("Affaire 1\)

Voilà je pense être bon la fonction GetIfExistAndOpenFile peut être encore améliorée...
Bonne prog

Salut Valtrase,

Je ne sais pas si tu te souviens ce post mais tu m'avais bien aidé.

Le fichier fonctionne bien. J'ai cependant un autre soucis :
Je n'arrives pas à récupérer les lignes notées HB.1 à 30 car ce sont des lignes qui ne font pas parties de la BDD OTI mais des lignes différentes à chaque devis.
J'ai essayé pas mal de choses mais cela ne fonctionne pas.

Pourrais-tu regarder cela?

Merci par avance
@+