Construction base de donée / Fichier multiutilisateur / COVID

Bonjour le forum,

Un peu d'historique s'impose : Voilà depuis près d'un an j'ai du abandonné un projet de création d'une base de donnée pour la commande de mes réactifs et consomable. Mais avec la crise covid j'ai été rappeler en urgence sur mon site d'origine pour gerer la flux des malades.

Et je suis retrouver avec mon ancien système de commande entre les mains qui fonctionne mais qui extrement compliqué et chronophage à mettre à jours. Actuellement j'ai 9 Fichiers ou chaque agents definie les besoins de son secteur. Et je passe une macro sur les 9 fichiers pour récuperer les données. Mon Probleme est la maintenance de ces 9 Fichiers, en effet étant dependant des obligations des marchées publiques, le référencement des réactifs et consommables change très régulièrement, et je me retrouve tout les mois avec une trentaine de ref à rechercher dans les 9 classeurs et les corriger.

J'aimerai travailler de manière inverse c'est à dire avoir une base de donnée, ou chaque utilisateur ne voit que les références qu'il l'interresse, mais pour avoir testé ce système je me suis apercut que tous le monde essayai de se connecter en même temps soit près 75 personnes, au dire que c'est pas la bonne méthode. Il me semble que le plus simple ressemble à une grosse usine à gaz, c'est dire avoir un fichier "Utilisateur" qui créer un fichier " temporaire" avec les données spécifiques de chaque utlisateur, exgtraite de la base de donnée, afin d'éviter l'encombrement des multiples connections, puis lors de la sauvegarde de ce fichier "Temporaire" réintégrer les commandes.... mais la solution que j'avais essayer allant dans ce sens était que certains utilisateur faisait leur commande sur plusieurs jours et me generait plusieurs fois la meme commande car ils ne pouvaient pas recharger la commande en cours.

Si l'un de vous voit un peu les différents problèmes et à une solution plausible à mettre en place pour que les utilisateurs puissent commander que leurs références, et reprendrent les commandes en cours plusieurs fois dans le mois, et qui pour moi n'engrendre qu'un fichier de commande à gerer et qu'une base de donnée à maintenir.

Je vous remercie d'avance , je laisse un fichier qui pourrait ressembler à la structure de la BD brute, ( il ya encore tout les doublons secteurs)

Je reste à votre disposition pour toutes questions complémentaires.

Bonjour,

Si j'ai bien compris ton idée, tu peux éventuellement dispatcher un "fichier maître référence" auprès des 75 utilisateurs, puis recompiler leur retour.

Dans ce cas, il y a ici une appli simple :

https://forum.excel-pratique.com/viewtopic.php?f=3&t=138521

Effectivement cette solution à bien des avantages ! je regarde ca. Pourrais je revenir vers toi en cas de question complémentaire / adaptation?

A ta disposition ...

Effectivement le code est d'une simplicité déconcertante, j'aurai fait moins bien en 200 lignes.

j 'ai une petite erreur sur le dernier fichier généré qui soit disant existe dejà ! Si je "l'ecrase" no problémo le fichier est correcte

du coup je suppose que l'on doit pouvoir appeller un fichier modèle pour les utilisateurs

Set xl = CreateObject("Excel.Application")
    xl.SheetsInNewWorkbook = 1

et je suppose que c'est ici qu'il faudrait appeler le fichier modèle, ? il me faut le chemin du fichier et son nom donc si je on le met dans le même repertoire que le dispacher on a :

Set xl = ThisWorkbook.Path & "" Application.GetOpenFilename("Model.xlsm ")"

Mais là evidement ma syntaxe est fausse et je bloque

Je suppose que je vais avoir une autre problematique lorsque je vais vouloir créer tous les mois un onglet sur le fichier à distance. As tu une idée pour que l'on génère une fois le fichier pour janvier par exemple mais que chaque mois je genère le mois d'après, l'idée d'avoir un onglet par mois me permet de mettre à jour la base de donnée regulierement et que l'onglet du mois d'apres est les bonnes références.

J'espères être compréhenssible c'est toujours difficile de dire ce que l'on veux qd on c'est pas le faire

Merci pour tes idées

Ci joint le dispacher avec mes données pour l'erreur

edlede a écrit :

j 'ai une petite erreur sur le dernier fichier généré qui soit disant existe dejà ! Si je "l'ecrase" no problémo le fichier est correcte

edlede a écrit :

du coup je suppose que l'on doit pouvoir appeller un fichier modèle pour les utilisateurs

edlede a écrit :

Set xl = ThisWorkbook.Path & "" Application.GetOpenFilename("Model.xlsm ")"

Mais là evidement ma syntaxe est fausse et je bloque

edlede a écrit :

Je suppose que je vais avoir une autre problematique lorsque je vais vouloir créer tous les mois un onglet sur le fichier à distance. As tu une idée pour que l'on génère une fois le fichier pour janvier par exemple mais que chaque mois je genère le mois d'après, l'idée d'avoir un onglet par mois me permet de mettre à jour la base de donnée regulierement et que l'onglet du mois d'apres est les bonnes références.

Merci j'avance également de mon coté, je suis un champion sur les erreurs de syntaxe

Tient je viens trouver un petit chiffre pour toi

edlede a écrit :

Tient je viens trouver un petit chiffre pour toi

A tester aussi ...

Avec un modèle ...

Option Explicit

Sub dispatcher()
Dim Tbl As Variant, data As Variant, i%
Dim dico1 As Object, cle1 As Variant, result1 As Variant
Dim wb As Excel.Workbook
Dim MonRepertoire, Repertoire As FileDialog, racine As String
Dim colonne$, critere%

    colonne = Application.InputBox("Entrez la colonne servant de critère de dispatching : ", "Saisie en texte (i.e : A B ...)", Type:=2)
    critere = ActiveSheet.Columns(colonne).Column

    racine = Split(ThisWorkbook.Name, ".")(0)

    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire de stockage des fichiers générés"
    Repertoire.Show
    If Repertoire.SelectedItems.Count = 0 Then Exit Sub
    MonRepertoire = Repertoire.SelectedItems(1)

    data = Cells(Rows.Count, 1).End(xlUp).CurrentRegion

    Set dico1 = CreateObject("Scripting.Dictionary")
    For i = LBound(data) + 1 To UBound(data) ' hors en-tête
        dico1(data(i, critere)) = ""
    Next

    For Each cle1 In dico1.Keys
        result1 = filtreArray(data, critere, cle1)
        Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & "Model.xlsx")
        wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(UBound(result1, 1), UBound(result1, 2)) = result1
        wb.SaveAs (MonRepertoire & "\" & racine & "_" & cle1 & ".xlsx")
        wb.Close
        Set wb = Nothing
    Next

    MsgBox "Terminé, fichiers sauvegardés sous """ & MonRepertoire & "\" & """ !"
End Sub

Ha incroyable ce nombre !!

Merci je teste pour la creation avec le modèle Merci !

Bonsoir Steelson

Je penses que tout fonctionne pour l'instant comme je veux à quelques peu de chose près sur la compil des données.

Ca bloque si je suis pas sur le bon onglet sur

[code]ws1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select

[/code]

J'ai ajouter un compteur qui sincremente apres la compilation ....et que dans mon code je précise ou il doit pointer :

Sub collecter()
Dim wbk1 As Workbook, wbk2 As Workbook, ws1 As Worksheet
Dim MonRepertoire, Repertoire As FileDialog, MonFichier$, derL%
Dim M As String

    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire de stockage des fichiers générés"
    Repertoire.Show
    If Repertoire.SelectedItems.Count = 0 Then Exit Sub
    MonRepertoire = Repertoire.SelectedItems(1) & "\"

    Set wbk1 = ThisWorkbook
    M = ThisWorkbook.Sheets("Param").Cells(1, 2)
    Set ws1 = wbk1.Sheets(M + 1) '----------------------------> ici je precise normalement l'onglet ou il doit pointer ???????
    Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Offset(1, 0).ClearContents
    MonFichier = Dir(MonRepertoire & "*.xlsm")

 Do While MonFichier <> ""
        ws1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
        derL = ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1
        Set wbk2 = Workbooks.Open(MonRepertoire & MonFichier)
        wbk2.Sheets(M + 1).Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Cells.Copy
        ws1.Paste
        Application.DisplayAlerts = False
            wbk2.Close False
        Application.DisplayAlerts = True
        Rows(derL).Delete Shift:=xlUp
        MonFichier = Dir
    Loop
    Sheets("Param").Cells(1, 2) = M + 1
    Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Cells(1, 1).Select

End Sub

Parcontre si je suis bien sur l'onglet à rappatrier ca fonctionne nickel, quelques chose m'échappe

Si tu as une idée...

J'ai mis le bouton sur l'onglet en question justement pour bien cibler le lieu de rapatriement des informations.

Je vais regarder car si je comprends bien tu es en multi-onglets donc.

Oui pour pouvoir regarder les antériorités rapidement, Merci

Pas sûr d'avoir bien tout compris, mais ceci m'interpelle :

Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Offset(1, 0).ClearContents

cette ligne est faite pour effacer les données avant compilation, il faut donc préciser

ws1.Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Offset(1, 0).ClearContents

idem sur

Rows(derL).Delete Shift:=xlUp

devient

ws1.Rows(derL).Delete Shift:=xlUp

Mais l'autre façon de faire est de préciser

Set ws1 = wbk1.Sheets(M + 1)
ws1.select

hé oui évidemment, effectivement , parfois c'est tellement sous mes yeux que je cherches midi à 14h. je test mais là normalement ca devrait fonctionner nickel

Tout fonctionne parfaitement merci !! je valide