Compilation automatique

Question

Bonjour, je me suis faites un tableau avec excel, je veux envoyer celui-ci èa une série de personne, et je veux qu'il y répondent et que quand il me reviens et que je l'ouvre, que mon fichier maitre se mettre èa jour avec les réponses, quel fonction je dois utiliser pour que ceci fonctionne?

Merci d'avance pour votre soutien

Answer 1

'Nécessite l 'ajoute de la bibliothèque suivante :

'"Microsoft Activex Data Object 2.x librairy"

'   ET

'"Microsoft Dao 3.6 Objects librairy"

Dans la fenêtre de l'éditeur de code, barre des menus / outils / références /

et dans la fenêtre ouvrante, tu coches les 2 bibliothèques mentionnées.

Dans ce qui suit, je fais 3 propositions quant à la manière de passer les paramètres

à la procédure  Extraire_Data_First_Excel_Sheet . Cette procédure à 2 paramètres

Le premier = Chemin du répertoire où sont assemblés tous tes fichiers

le deuxième = la cellule de la feuille où tu veux que ta copie débute.

Il y a différente syntaxe possible selon ton environnement et je te

donne 3 exemples.

Extraire_Data_First_Excel_Sheet "c:\AAA", Range("E4")

"c:\AAA"  = Chemin où sont les fichiers

Range("E4")  = Cellule de la feuille active où débutera la copie des données importées.

---

MichD

---

"pstrophe" a écrit dans le message de groupe de discussion : *** Adresse électronique supprimée pour cause de confidentialité ***...

Bon j'ai fais des essaies différent, mais j'ai toujorus cette erreure:

Erreur D'exécution '9'

l'indice n'appartient pas à la sélection

Aussi je ne comprends pas ce commentaires :

'Nécessite l 'ajoute de la bibliothèque suivante :

'"Microsoft Activex Data Object 2.x librairy"

'   ET

'"Microsoft Dao 3.6 Objects librairy"

voici le code dans ma feuille VBA:

Sub Test()

'Appel d'une procédure ayant 2 paramêtres

'A ) Répertoire à scanner

    'Ne pas oublier le "" à la fin comme dans "c:\AAA"

'B ) 'L'adresse de la première cellule du coin supérieur

     'gauche où seront copiées les données recueillies

     'Différente syntaxe possible d'indiquer la cellule

     'à partir de laquelle seront copiés les résultats.

     '----------1----------      'Même classeur que la procédure, dans la Feuil2

    'Extraire_Data_First_Excel_Sheet "c:\AAA", _

        ThisWorkbook.Worksheets("Feuil2").Range("G10")

    '-----------2----------     'Autre classeur ouvert que celui de la procédure

    Extraire_Data_First_Excel_Sheet "F:\Facturations\FORMATION\Formation\SuiviPassage2007", _

        Workbooks("Classeur2").Worksheets("Feuil2").Range("E14")

    ''-----------3----------     'Dans la feuille active du classeur actif au

    'moment de lancer la procédure

 '   Extraire_Data_First_Excel_Sheet "c:\AAA", Range("E4")

End Sub

'------------------------------------------

Sub Extraire_Data_First_Excel_Sheet(Chemin As String, Rg As Range)

'Nécessite l 'ajoute de la bibliothèque suivante :

'"Microsoft Activex Data Object 2.x librairy"

'   ET

'"Microsoft Dao 3.6 Objects librairy"

'Extrait les données de plusieurs classeurs d'un même

'répertoire en prenant pour acquis que les données ont

'la même structure. Le nom de la première feuille est

'obtenue par la fonction "FirstExcelSheetName"

Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset

Dim Requete As String, NomFeuille As String

Dim file As String, C As Integer, Ok As Integer

Dim ModeCalcul As String

'Extrait le premier fichier du répertoire

file = Dir(Chemin & "\*.xls")

ModeCalcul = Application.Calculation

Application.Calculation = xlCalculationManual

Application.ScreenUpdating = False

Application.EnableEvents = False

Do While file <> ""

    'Exclure le classeur où sont copiées les données

    'pour ne pas dédoubler les data...

    If Chemin & Rg.Parent.Parent.Name <> Chemin & file Then

        'Identifier la cellule supérieur de gauche

        'où seront copiées les données

        If Rg(1, 1) = "" Then

            Set Rg = Rg(1, 1)

        Else

            Set Rg = Rg.EntireColumn.Find(What:="*", LookIn:=xlFormulas, _

                SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Offset(1)

            Ok = 1

        End If

        'établir la connection avec le fichier...

        Set Conn = New ADODB.Connection

        Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _

               "Data Source=" & Chemin & file & ";" & _

               "Extended Properties=""Excel 8.0;HDR=YES;"""

        'détermine le nom de la première feuille du classeur

        NomFeuille = FirstExcelSheetName(Chemin & file)

        'Détermine la requête à être exécuté

        Requete = "SELECT * From [" & NomFeuille & "]"

        'Exécution de la requête

        Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic

        'Copie le nom des champs du recordset vers Excel

        'dans le cas du premier classeur seulement

        If Ok <> 1 Then

            Do

                Rg.Offset(, C) = Rst.Fields(C).Name

                C = C + 1

                x = x + 1

            Loop Until x = Rst.Fields.Count

            'Copie le recordset vers Excel

            Rg.Offset(1).CopyFromRecordset Rst

        Else

            'Copie le recordset vers Excel

            Rg.CopyFromRecordset Rst

        End If

        'Ferme le recordset et la connection

        Rst.Close: Conn.Close

        'Passe au classeur suivant

        file = Dir()

    Else

        'Passe au classeur suivant si le fichier

        'où sont copiées les données est le même

        'que celui qui est traité dans cette sub.

        file = Dir()

    End If

Loop

    Application.EnableEvents = True

    Application.Calculation = ModeCalcul

    Set Rst = Nothing: Set Conn = Nothing

    Set Rg = Nothing

End Sub

'------------------------------------------ Function FirstExcelSheetName(Fichier As String)

'"Microsoft Dao 3.6 Objects librairy"

Dim XlDb As DAO.Database

Dim TbL As DAO.TableDef

Set XlDb = OpenDatabase(Fichier, False, True, "Excel 8.0;")

FirstExcelSheetName = XlDb.TableDefs(0).Name

XlDb.Close: Set XlDb = Nothing

End Function

'------------------------------------------

Merci encore

Answer 2

Wow, ok I will try to do this, Of course my experience on MAcro is limited, I have done some if and then's but this one is somthing else,

thank you very much, I will let you know how it turns out!

Answer 3

Bonjour,

Si tu veux faire la compilation de plusieurs fichiers que tu reçois, je te propose la solution suivante :

A ) Tu places ces fichiers dans un répertoire particulier

B ) Tu utilises le type de procédure que je soumets en les plaçant dans un module standard dans ton fichier de compilation que tu placeras dans le même répertoire de tes fichiers cible.

C ) Tu affectes à un bouton dans ta feuille la macro "Test"

D ) À chaque fois que tu cliqueras sur le bouton, toutes les données de la PREMIÈRE FEUILLE de chaque classeur seront extraites dans ton classeur compilation.

E ) Il est évident que toutes les premières feuilles de chaque classeur doivent avoir la même structure.

     La ligne 1:1 représente la ligne d'étiquettes de ton tableau.

F ) Selon ton environnement, la procédure "Test" possède plusieurs de ligne pour appeler le reste de la procédure. Il s'agit de choisir d'activer celle qui convient à ton environnement.

G ) Évidemment, il y a certaines variables que tu devras adapter comme le chemin où sont tes fichiers.

Toutes les feuilles de données sont réputées avoir

une ligne d'étiquette définissant les champs de la table.

Ne pas oublier de déclarer les bibliothèques mentionnées

dans la procédure : "Extraire_Data_First_Excel_Sheet"

'------------------------------------------

Sub Test()

'Appel d'une procédure ayant 2 paramêtres

'A ) Répertoire à scanner

    'Ne pas oublier le "" à la fin comme dans "c:\AAA"

'B ) 'L'adresse de la première cellule du coin supérieur

     'gauche où seront copiées les données recueillies

     'Différente syntaxe possible d'indiquer la cellule

     'à partir de laquelle seront copiés les résultats.

     '----------1----------

     'Même classeur que la procédure, dans la Feuil2

    'Extraire_Data_First_Excel_Sheet "c:\AAA", _

        ThisWorkbook.Worksheets("Feuil2").Range("G10")

    '-----------2----------

    'Autre classeur ouvert que celui de la procédure

    Extraire_Data_First_Excel_Sheet "c:\AAA", _

        Workbooks("Classeur2").Worksheets("Feuil2").Range("G10")

    ''-----------3----------

    'Dans la feuille active du classeur actif au

    'moment de lancer la procédure

 '   Extraire_Data_First_Excel_Sheet "c:\AAA", Range("G10")

End Sub

'------------------------------------------

Sub Extraire_Data_First_Excel_Sheet(Chemin As String, Rg As Range)

'Nécessite l 'ajoute de la bibliothèque suivante :

'"Microsoft Activex Data Object 2.x librairy"

'   ET

'"Microsoft Dao 3.6 Objects librairy"

'Extrait les données de plusieurs classeurs d'un même

'répertoire en prenant pour acquis que les données ont

'la même structure. Le nom de la première feuille est

'obtenue par la fonction "FirstExcelSheetName"

Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset

Dim Requete As String, NomFeuille As String

Dim file As String, C As Integer, Ok As Integer

Dim ModeCalcul As String

'Extrait le premier fichier du répertoire

file = Dir(Chemin & "\*.xls")

ModeCalcul = Application.Calculation

Application.Calculation = xlCalculationManual

Application.ScreenUpdating = False

Application.EnableEvents = False

Do While file <> ""

    'Exclure le classeur où sont copiées les données

    'pour ne pas dédoubler les data...

    If Chemin & Rg.Parent.Parent.Name <> Chemin & file Then

        'Identifier la cellule supérieur de gauche

        'où seront copiées les données

        If Rg(1, 1) = "" Then

            Set Rg = Rg(1, 1)

        Else

            Set Rg = Rg.EntireColumn.Find(What:="*", LookIn:=xlFormulas, _

                SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Offset(1)

            Ok = 1

        End If

        'établir la connection avec le fichier...

        Set Conn = New ADODB.Connection

        Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _

               "Data Source=" & Chemin & file & ";" & _

               "Extended Properties=""Excel 8.0;HDR=YES;"""

        'détermine le nom de la première feuille du classeur

        NomFeuille = FirstExcelSheetName(Chemin & file)

        'Détermine la requête à être exécuté

        Requete = "SELECT * From [" & NomFeuille & "]"

        'Exécution de la requête

        Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic

        'Copie le nom des champs du recordset vers Excel

        'dans le cas du premier classeur seulement

        If Ok <> 1 Then

            Do

                Rg.Offset(, C) = Rst.Fields(C).Name

                C = C + 1

                x = x + 1

            Loop Until x = Rst.Fields.Count

            'Copie le recordset vers Excel

            Rg.Offset(1).CopyFromRecordset Rst

        Else

            'Copie le recordset vers Excel

            Rg.CopyFromRecordset Rst

        End If

        'Ferme le recordset et la connection

        Rst.Close: Conn.Close

        'Passe au classeur suivant

        file = Dir()

    Else

        'Passe au classeur suivant si le fichier

        'où sont copiées les données est le même

        'que celui qui est traité dans cette sub.

        file = Dir()

    End If

Loop

    Application.EnableEvents = True

    Application.Calculation = ModeCalcul

    Set Rst = Nothing: Set Conn = Nothing

    Set Rg = Nothing

End Sub

'------------------------------------------

Function FirstExcelSheetName(Fichier As String)

'"Microsoft Dao 3.6 Objects librairy"

Dim XlDb As DAO.Database

Dim TbL As DAO.TableDef

Set XlDb = OpenDatabase(Fichier, False, True, "Excel 8.0;")

FirstExcelSheetName = XlDb.TableDefs(0).Name

XlDb.Close: Set XlDb = Nothing

End Function

'------------------------------------------

---

MichD

---

"pstrophe" a écrit dans le message de groupe de discussion : *** Adresse électronique supprimée pour cause de confidentialité ***...

Bonjour,

voici le fichier sur le lien:http://cjoint.com/?iyuWNKhUps

Dans le fichier, la partie en beige restera fix, pas possible de modifier, la partie rose sera une liste déroulante et la partie verte sera là ou les usagers vont mettre un x.

je vais envoyer ce fichier via le courriel et j'aimerais que quand il me reviens, que dès l'ouverture de leur fichier de retour, le mien se mettre à jour avec leur réponse.

Est-ce possible et si oui , je dois utiliser quel fonction?

merci encore

Answer 4

Bonjour,

voici le fichier sur le lien:http://cjoint.com/?iyuWNKhUps

Dans le fichier, la partie en beige restera fix, pas possible de modifier, la partie rose sera une liste déroulante et la partie verte sera là ou les usagers vont mettre un x.

je vais envoyer ce fichier via le courriel et j'aimerais que quand il me reviens, que dès l'ouverture de leur fichier de retour, le mien se mettre à jour avec leur réponse.

Est-ce possible et si oui , je dois utiliser quel fonction?

merci encore

Answer 5

Bonjour.

Peux-tu mettre un modèle de ton fichier maître sur www.cjoint.com et

poster ici le lien généré ? Ce que je ne comprends pas, c'est que, si

chacun de tes interlocuteurs modifie la même cellule, celle-ci prendra

la valeur donnée par le dernier classeur traité.

Cordialement.

Daniel