ListBox liste choix multiple

Version imprimable

Voir 40 message(s) de cette discussion en une page

07/10/2022, 00h28
Valtrase

Salut,
Allez avant d'aller au lit

Citation:

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

Citation:

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.
07/10/2022, 21h40
scoobydoos

1 pièce(s) jointe(s)

Citation:

Envoyé par Valtrase

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
@+

Pièce jointe 626887
07/10/2022, 23h49
Valtrase

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

Citation:

Envoyé par Valtrase

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:

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
@+

08/10/2022, 21h04
Valtrase

Salut,

Citation:

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

Citation:

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

Citation:

Envoyé par Valtrase

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:

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
@+

Salut Valtrase,

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

Code:

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
@+

10/10/2022, 21h10
scoobydoos

1 pièce(s) jointe(s)

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

Pièce jointe 627009

Merci par avance
@+
10/10/2022, 23h18
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. :roll:

Voili voilou bonne prog

Citation:

Envoyé par 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. :roll:

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:

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:

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
@+

2 pièce(s) jointe(s)

Re,

Ok j'ai trouvé l'effacement du tableau ;)
Code:

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

Pièce jointe 627072

Sur le USF (UserForm1) :
Code:

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 ?

Pièce jointe 627073

Merci par avance
@+

11/10/2022, 20h57
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 :furieux:

Merci pour ton aide

@+

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 :mouarf:
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:

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

Citation:
Envoyé par 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 :mouarf:
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:

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
@+

12/10/2022, 13h57
Valtrase

Salut,

Citation:

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...:roll:
J'ai aussi changé les références des champs nommés pour les basculer dans la feuille paramètres.
13/10/2022, 21h48
scoobydoos
Citation:

Envoyé par Valtrase

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

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

Et dans le Power Query :
Code:

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:

=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
@+
14/10/2022, 01h16
Valtrase
Salut,

Citation:

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

Citation:

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:

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
14/10/2022, 09h46
scoobydoos
Citation:
Envoyé par Valtrase

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:

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
@+

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:

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:

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:

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:

1
2
 
MsgBox GetIfExistAndOpenFile("Affaire 1\)

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

Citation:

Envoyé par 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:

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:

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:

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:

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
@+

Voir 40 message(s) de cette discussion en une page