Formulaire word : automatisation de copie des données dans un fichier excel.
Soyez le premier à donner votre avis sur cette source.
Snippet vu 27 789 fois - Téléchargée 29 fois
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
- Formulaire word : automatisation de copie des données dans un fichier excel.
- VBA Excel : Copie de données entre 2 fichier ✓ - Forum - Visual Basic
- Lire des données d'un fichier excel (utilisation du contrôle data) - Codes sources - Visual Basic / VB.NET (Base de Donnees)
- Comment copier des données entre deux fichiers Excel ✓ - Forum - VBA Office (Excel, Word ...)
- Recherche de données d'un fichier Excel dans un fichier txt ✓ - Forum - VB.NET
- Inscrire des données dans deux fichiers excel a partir d'un userform ✓ - Forum - VB.NET
Commentaires
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
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
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.
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.
Set xls = CreateObject("EXCEL.APPLICATION")
[...]
xls.Workbooks.Worksheets(
xls.Workbooks.Rows
et voilà le tour est joué !
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.