Formulaire word : automatisation de copie des données dans un fichier excel.

Soyez le premier à donner votre avis sur cette source.

Snippet vu 27 719 fois - Téléchargée 29 fois

Commenter

Contenu du snippet

Macro VB Word qui automatise l'enregistrement et la copie les données d'un formulaire Word dans un fichier TXT. Comme un formulaire reçu correspond à un fichier TXT, le but du jeu est de créer une petite base de données, ici sous Excel. mais tout se fait depuis WORD, à réception du formulaire, ce qui évite les manoeuvres incessantes entre Word et Excel

Source / Exemple : 


Sub Extraction_Formulaire()

'à la réception du formulaire, le code ci-dessous automatise la fonction du menu Outils - Option - Formulaire : enregistrer uniquement les données

     With Options
        .AllowFastSave = False
        .BackgroundSave = True
        .CreateBackup = True
        .SavePropertiesPrompt = False
        .SaveInterval = 10
        .SaveNormalPrompt = False
        .OptimizeForWord97byDefault = False
    End With
    With ActiveDocument
        .ReadOnlyRecommended = False
        .EmbedTrueTypeFonts = False
        .SaveFormsData = True
        .SaveSubsetFonts = False
        .Password = ""
        .WritePassword = ""
        .OptimizeForWord97 = False
    End With
    Application.DefaultSaveFormat = ""

'copier les données dans un fichier TXT 
    ChangeFileOpenDirectory "C:\Mes documents\"
    ActiveDocument.SaveAs FileName:="Fichier.txt", FileFormat:= _
        wdFormatText, LockComments:=False, Password:="", AddToRecentFiles:=True, _
        WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
         SaveNativePictureFormat:=False, SaveFormsData:=True, SaveAsAOCELetter:= _
        False
    ActiveDocument.Close
    
'ouvre Fichier.TXT sous Excel en format délimité par des points virgule
 Dim xls As Object, wkb As Excel.Workbook
 
 Set xls = New Excel.Application
 xls.Visible = True
 
 Set wkb = xls.Workbooks.Open("C:\Mes documents\Fichier.txt")
    
'dans cet exemple, le formulaire comporte 27 réponses
    Workbooks.OpenText FileName:= _
        "C:\Mes documents\Fichier.txt" _
        , Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
        :=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True _
        , Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1) _
        , Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
        , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
        Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1))
    
    'copie la ligne de données dans le fichier Excel qui servira de base de données puis ferme le fichier TXT
        Worksheets("Base1").Activate
        Rows("1:1").Select
        Rows("1:1").Copy
        ActiveWorkbook.Close
       
     'ouvre le classeur Base_de_données.xls et active la feuille Base1 pour y coller la sélection
    Workbooks.Open FileName:= _
    "C:\Mes documents\Base_de_données.xls"
      
    'copie la sélection sous la ligne non vide
    Worksheets("base1").Activate
    Range("A1").Select
    Do Until ActiveCell = ""
        ActiveCell.Offset(1, 0).Select
    Loop
        ActiveSheet.Paste
        ActiveWorkbook.Save
        ActiveWorkbook.Close
End Sub

A voir également

Ajouter un commentaire

Commentaires

Signaler
chablat
Messages postés
1
Date d'inscription
mercredi 5 décembre 2007
Statut
Membre
Dernière intervention
5 décembre 2007
 -
Bonjour,

Pour éviter le retour chariot dans Excel, j'ai copié dans un fichier intermédiaire. Après j'utiliser Fichiers.txt (attention, chez moi, le fichier existe déjà)

Dim fso1, fso2
Dim fs1, fs2 As Object
Dim Lecture As String

Set fso1 = CreateObject("Scripting.FileSystemObject")
Set fso2 = CreateObject("Scripting.FileSystemObject")
Set fs1 = fso1.OpenTextFile("Fichier.txt")
Set fs2 = fso2.OpenTextFile("Fichiers.txt", 2)
Lecture = fs1.Readline
fs2.Write Replace(Lecture, Chr(13), " ")
fs1.Close
fs2.Close

Set fs1 = Nothing
Set fs2 = Nothing
Signaler
Fouedou77
Messages postés
1
Date d'inscription
mardi 23 août 2005
Statut
Membre
Dernière intervention
19 août 2008
 -
Bonjour,

J'ai ce message d'erreur lors de l'execution de la macro : Erreur de compilation. Type défini par l'utilisateur non défini

, wkb As Excel.Workbook

Je ne comprends rien du tout... :(

Merci d'avance pour votre aide précieuse
Signaler
jvienne
Messages postés
6
Date d'inscription
mercredi 26 novembre 2003
Statut
Membre
Dernière intervention
22 juillet 2009
 -
bonjour,

ce code m'interesse vraiment, mais impossible de le faire fonctionner chez moi malgres les remplacements expliqués ci-dessus.
Pouvez-vous SVP réecrire le programme avec les corrections car excel ne reconnait pas plusieur type comme la Dim de wkb...

Merci.
Signaler
maydaybigfoot
Messages postés
4
Date d'inscription
lundi 8 décembre 2003
Statut
Membre
Dernière intervention
28 août 2006
 -
Il reste toutefois un gros problème sur cette macro : si jamais la personne a saisi un retour chariot dans le formulaire, le fichier texte retourne automatiquement à la ligne.

Exemple :
"titi";"toto";"tata"; -> fichier OK
"titi";"toto";"tata
tutu
truc"; -> fichier !OK

Auriez vous une solution pour remplacer sous Word le retour chariot (et le retour à la ligne) par un caractère identifié comme retour à la ligne sous Excel.

merci d'avance.
Signaler
maydaybigfoot
Messages postés
4
Date d'inscription
lundi 8 décembre 2003
Statut
Membre
Dernière intervention
28 août 2006
 -
il faut remplacer par :
Set xls = CreateObject("EXCEL.APPLICATION")
[...]
xls.Workbooks.Worksheets(
xls.Workbooks.Rows

et voilà le tour est joué !
Afficher les 6 commentaires
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.