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
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.