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

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

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.