Alimentation automatique de bases des données

Bonjour le Forum,

J’ai besoin d’une aide d’un spécialiste de VB.

Il y a un fichier « Bon de commande » (ci-joint) qui sera envoyé par mail au service gestion par une de 20 équipes. Après finalisation par le gestionnaire, le contenue de cette commande (la plage $C$3 - $Z la dernière ligne de la commande) doit être enregistré/ dupliqué dans deux bases de données différentes immédiatement après la dernière ligne de la commande précédente déjà enregistrée dans ces deux bases:

1. Base de données de l’équipe. Le numéro de chaque équipe apparaît dans la colonne C du bon de commande.

2. Base de données consolidées – toutes les commandes de toutes les équipes.

Chaque base de données est constituée de deux pages – la page avec toute la data (toute les commandes) qui se nomme « DB » et la page avec un tableau croisé dynamique « PT »

Le format du bon commande est figé, alors que le taille (la quantité de lignes) de chaque commande peut varier de 4 lignes au minimum jusqu’au 40 au maximum.

En fait, je voudrais ajouter deux boutons de commande le premier pour alimenter la base de données de l’équipe et le second pour la base consolidée. Si techniquement un seul bouton peut répondre à ce besoin, c’est encore mieux.

Dans tous les cas j’ai besoin de rafraîchir les tableaux croisés dynamiques. Peut-être le même bouton pourra répondre à ce besoin aussi.

Un élément de contrôle supplémentaire doit intervenir dans cette opération : pouvoir s’assurer au moment de dupliquer la commande qu’il n’y aura de doublon de cette commande dans les deux bases. Les paramètres des contrôles sont les colonnes C et D (numéro d’équipe et numéro de commande)

Malheureusement, je suis moins que nulle dans la programmation et je « ne parle pas » le VBA.

Est-ce qu’il y a un spécialiste qui pourra m’aider?

D’autres utilisateurs sont probablement dans le même cas comme moi.

Merci en avance !

Bonjour Baton,

Pour mieux t'aider, il faut que tu y ailles par étape. Autant d'infos en une fois ça fait beaucoup (pour ma part)

Ici, tu as joint qu'un seul fichier, il faudrait que tu joignes les fichiers dont on a besoin pour t'aider.

Où se trouvent ces feuilles DB et PT ?

Bonjour vba-new,

Ci-joint tu trouves la base de données d'une équipe.

Dans le fichier de bon de commande il y a plusieurs liaisons / formules « built-in ». Peut-être, il sera mieux pour le fichier de base de données si les données qui viennent d’une bon de commande seront collées « as value » pour ne pas alourdir la base ?

Merci,

Baton

vba-new a écrit :

Où se trouvent ces feuilles DB et PT ?

-- 13 Juil 2011, 10:04 --

Voilà la base des données consolidées

vba-new a écrit :

Où se trouvent ces feuilles DB et PT ?

Bonjour Baton,

Quelques questions :

1- Quel est le nom exact des différents fichiers ?

2- Tous les fichiers (bon de commande, fichier consolidé, fichier équipe) se trouvent-ils dans le même répertoire ?

Bonjour vba-new,

Il y a un dossier qui s'appellera "Depenses".

Dans ce dossier il y aura des fichiers suivants:

"BD consolidées Model"

"BD d'administration Model"

"BD d'équipe 1 Model"

"BD d'équipe 2 Model"....

"BD d'équipe 25 Model"

le mot "Model" n'est pas obligatoire. Il peut soit être utilisé dans tous les fichiers soit être supprimé partout.

Amicalement,

Baton

Bonjour Baton,

Un premier essai. Il faut lancer la macro "consolide" :

Adapte le chemin du répertoire contenant les différentes bases de données à la ligne suivante :

    repertoire = "C:\xxxxxxx\" 'mettre le chemin du répertoire contenant les BD ici, laisser le "\" à la fin

Salut vba-new,

le dossier se trouve dans le serveur et le chemin est:

\gestion\Dépenses\BD cosolidées.xls

\gestion\Dépenses\BD d'administration.xls

\gestion\Dépenses\BD d'équipe 1.xls

je ne sais pas s'il faut ajouter le "C:"

J'ai essayé avec executer le macro avec deux possibilités (avec et sans C:) mais deux fois j'ai reçu

Erreur d'exécution '5'

Argument ou appel de procédure incorrect

comment et quoi dois-je corriger?

amicalement,

Baton

Bon, je vois que tes fichiers n'ont pas le même nom. On verra ça après.

Pour le répertoire, tu dois mettre le chemin complet. Ça doit pas être très différent sur un serveur.

Baton a écrit :

J'ai essayé avec executer le macro avec deux possibilités (avec et sans C:) mais deux fois j'ai reçu

Erreur d'exécution '5'

Argument ou appel de procédure incorrect

La ligne

If Left(CurDir, 1) <> Left(repertoire, 1) Then ChDrive Left(repertoire, 1) & ":": ChDir repertoire

est soulignée et

ChDrive Left(repertoire, 1) & ":"

est colorée au jaune

Il faut que tu ajoutes la lettre du serveur dans le chemin du répertoire.

Salut vba-new,

Je suis desolé pour ma reponse tardée.

En fait, j’ai essayé plusiers fois de “jouer” avec le syntax propose, mais ça ne marche pas et le macro ne fonctionne pas. Il me semble que le problème apparis parce qu’on utilise le Macintosh. Peut-être le syntax est different pour le Mac?

Le nom du fichier est BD consolidées.xls

Le repertoir est \Volume\gestion\Dépenses\

Dans le macro c’est écrit comme ça

Application.ScreenUpdating = False

'classeur maître : Fichier contenant le bon de commande

Set WbkMaitre = ThisWorkbook

repertoire = "\Volume\gestion\Dépenses\" 'mettre le chemin du répertoire contenant les BD ici, laisser le "\" à la fin

If Left(CurDir, 1) <> Left(repertoire, 1) Then ChDrive Left(repertoire, 1) & ":": ChDir repertoire

'classeur cible 1 : Fichier de commandes consolidées

Workbooks.Open repertoire & "BD consolidées.xls"

Set WbkConso = ActiveWorkbook

Et la partie ChDrive Left(repertoire, 1) & ":" toujours est colorée en jaune.

Essaie en mettant un ' devant cette partie du code :

If Left(CurDir, 1) <> Left(repertoire, 1) Then ChDrive Left(repertoire, 1) & ":": ChDir repertoire

comme ceci :

'If Left(CurDir, 1) <> Left(repertoire, 1) Then ChDrive Left(repertoire, 1) & ":": ChDir repertoire

maintenant il me montre " Erreur d'exécution '1004':

Fichier inaccessible

et dans le code la ligne

Workbooks.Open repertoire & "BD consolidées.xls"

est en jaune

Est-ce que le serveur a une lettre associée ou pas ?

Je ne sais pas comment marche les répertoires sur MAC.

Quel est par exemple le chemin complet d'un de tes fichiers sur le bureau ?

salut,

on a trouvé le bon syntax pour la chemin du fichier sur Mac:" NomVolume:chemin:fichier.xls"

maintenant on est bloqué

With WbkMaitre

.Activate

Set mondico = CreateObject("Scripting.Dictionary") <-- ligne en jaune dans le débogueur

merci

Bonjour Baton,

Désolé j'avais zappé ton post

Toujours un peu difficile lorsqu'on a pas MAC. Effectivement, la ligne qui fait défaut est spécifique à Microsoft.

Réessaie en remplaçant la macro Consolide par celle-ci :

Sub consolide()
    Dim WbkMaitre As Workbook, WbkConso As Workbook
    Dim nbLign As Long, derLign&, doublon&, i&, j&, k&, cpt&, derLignC&, derLignA&
    Dim TblCde, temp
    Dim repertoire As String
    Dim cel As Range, trouve As Range

    Application.ScreenUpdating = False
    'classeur maître : Fichier contenant le bon de commande
    Set WbkMaitre = ThisWorkbook
    repertoire = WbkMaitre.Path & "\" 'mettre le chemin du répertoire contenant les BD ici, laisser le "\" à la fin
    'If Left(CurDir, 1) <> Left(repertoire, 1) Then ChDrive Left(repertoire, 1) & ":": ChDir repertoire
    'classeur cible 1 : Fichier de commandes consolidées
    Workbooks.Open repertoire & "BD consolidées Model .xls"
    Set WbkConso = ActiveWorkbook

    With WbkMaitre.Sheets("Commande")
        'compte le nombre de ligne de commande
        nbLign = .Application.WorksheetFunction.Count(.Range("C:C"))

        'si le nombre de ligne est nul on sort de la macro
        If nbLign = 0 Then MsgBox "La commande ne comporte aucune ligne": Exit Sub

        Set TblCde = .[C3].Resize(nbLign, 24)
    End With

    With WbkConso
        .Activate
        With .Sheets("Data")
            derLign = .Range("C" & Rows.Count).End(xlUp).Row + 1
            .Range("C" & derLign).Resize(nbLign, 24).Value = TblCde.Value
            TblCde.Copy
            .Range("C" & derLign).PasteSpecial Paste:=xlPasteFormats
            Application.CutCopyMode = False
            'suppression des doublons
            For Each cel In .Range("C" & derLign).Resize(nbLign)
                doublon = Evaluate("SumProduct((" & .Range("C3:C" & derLign - 1).Address & "=" & cel.Value & ")*(" & .Range("D3:D" & derLign - 1).Address & "=" & cel.Offset(, 1).Value & "))")
                If doublon > 0 Then Cells(cel.Row, 1).Value = "$$$"
            Next cel
            Set trouve = .Range("A" & derLign).Resize(nbLign).Find("$$$", LookAt:=xlWhole)
            If Not trouve Is Nothing Then
                For i = nbLign + derLign - 1 To derLign Step -1
                    If .Cells(i, 1) = "$$$" Then .Rows(i).Delete
                Next i
            End If
            derLignC = .Range("C" & Rows.Count).End(xlUp).Row
            derLignA = IIf(.Range("A" & Rows.Count).End(xlUp).Row + 1 < 3, 3, .Range("A" & Rows.Count).End(xlUp).Row + 1)
            If derLignC > derLignA Then
                For i = derLignA To derLignC
                    .Cells(i, 1) = .Cells(i - 1, 1) + 1
                Next i
            End If
        End With
        '.Close
    End With

    With WbkMaitre
        .Activate
        a = .Sheets("Commande").Range("c3").Resize(nbLign).Value
        lim = UBound(a)
        ReDim temp(1 To lim, 1 To 1)
        k = 1
        cpt = 0
        temp(1, 1) = a(1, 1)
        For i = 1 To lim
            For j = 1 To lim
                If a(i, 1) = temp(j, 1) Then Exit For
                cpt = cpt + 1
            Next j
            If cpt = lim Then k = k + 1: temp(k, 1) = a(i, 1)
            cpt = 0
        Next i
        For i = 1 To k
            Call Cde_Equip(WbkMaitre, .Sheets("Commande"), repertoire, temp(i, 1))
        Next i
    End With
End Sub

N'oublie pas d'adapter le répertoire.

new-vba,

step-by-step...

Ton code du macro "cosolide" marche parfaitement. par contre, maintenant le problème est avec

Sub Cde_Equip(Maitre As Workbook, FeuilBase As Worksheet, ByVal rep As String, ByVal numEquip As Long)

Dim nbLign As Long, derLign&, i&, derLignA&, derLignC&

Dim trouve As Range, plageEquip As Range

FeuilBase.Copy before:=Maitre.Sheets(1)

With ActiveSheet

.Sort.SortFields.Clear

la dernière ligne est colorée en jaune

pourras-tu recommende qqc?

Merci

Salut Baton,

Essaie en remplaçant les lignes :

        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range( _
                                  "C3:C45"), SortOn:=xlSortOnValues, Order:=xlAscending
        .Sort.SortFields.Add Key:=.Range( _
                                  "D3:D45"), SortOn:=xlSortOnValues, Order:=xlAscending
        With .Sort
            .SetRange Range("C3:Z45")
            .Orientation = xlTopToBottom
            .Apply
        End With

Par celle-ci :

        .Range("C3:Z45").Sort Key1:=Range("C3"), Order1:=xlAscending, key2:=Range("D3"), Order2:=xlAscending

vba-new

je les ai remplcé

maintenant il me montre que le problème est avec cette ligne:

.Range("C3:Z45").Sort Key1:=Range("C3"), Order1:=xlAscending, key2:=Range("D3"), Order2:=xlAscending

Difficile de travailler à l'aveugle

Et comme ça ?

Range("C3:Z45").Sort Key1:=Range("C3"), Order1:=xlAscending, key2:=Range("D3"), Order2:=xlAscending

(Sans le point au début)