formulaire word qui rempli un fichier excel

[ennrik]

bonjour,

je viens de créer avec Word un formulaire de satisfaction qui me permettra de remplir un tableau excel pour des statistiques.
la macro sous word est celle-ci (adaptation de plusieurs macros trouvées sur les forums):

Sub texte()
'
' texte Macro
'
'
ActiveDocument.SaveFormsData = True
ActiveDocument.SaveAs FileName:="temp.txt", FileFormat:=wdFormatText, _
LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=True, SaveAsAOCELetter:= _
False, Encoding:=1252, InsertLineBreaks:=False, AllowSubstitutions:=False _
, LineEnding:=wdCRLF

'Ouverture d'Excel

Dim appXl As Excel.Application
Dim Wb As Excel.Workbook

Set appXl = CreateObject("Excel.Application")
appXl.Visible = True

'Set Wb = appXl.Workbooks.Open("C:\Users\baptistee\Desktop\ennrik.xlsx")



'Copie du ficher texte dans le fichier xls avec séparateur ; et ,
appXl.Workbooks.OpenText "C:\Users\baptistee\Desktop\temp.txt", Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=True, Space:=False



'Enregistrer sous c:\nomduclient.xls Dim MonFichier
MonFichier = "C:\Users\baptistee\Desktop\ennrik.xlsx"
ActiveWorkbook.SaveAs FileName:=MonFichier, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False


appXl.Application.Quit

End Sub

cependant je n'arrive qu'à créer un fichier excel avec une ligne de donnés mais je voudrais mettre ces données dans un fichier existant (ennrik.xlsx) et qu'à chaque nouvelles données il prennent la ligne vierge en dessous.
merci de votre aide.

 

[ennrik]

Re : formulaire word qui rempli un fichier excel

il y a t'il quelqu'un qui peut m'aider?
merci

 

[Twiki]

Re : formulaire word qui rempli un fichier excel

Bonjour,

Personnellement je suis parti pour résoudre ce problème de la solution inverse. c.à.d de récupérer les données contenues dans « n » formulaire(s) word dans « n » ligne(s) d’une feuille de calcul Excel. \O/

Comme je viens de le faire et que je suis parti d’une solution trouvée sur ce site, il me paraît opportun d’en fournir la solution pour ceux que cela peut intéresser.

Ci-dessous le script à coller dans un module vba sous Excel + il faut avoir accès aux différentes librairies (ici pour manipuler les objets « word »).

BàV

Sub ImportDataWord()
Dim Wd As Word.Application
Dim Chemin As String
Dim i As Byte
Dim x As FileSearch

'fait par TWIKI le 20/11/2009
' cette Macro VBA, permet de récupérer en ligne les données contenues dans un formulaire Word sous Excel,
' ainsi que le nom des champs qui seront indiqués en colonne dans la feuille de calcul.
' -> on peut sélectionner 1 à n document word en même temps pour les importer dans une même feuille de calcul
' -> on sélectionne le(s) document(s) word à partir d'une fenêtre de recherche Windows
' -> la macro indique les colonnes en rouge si les documents n'ont pas la même structure


On Error GoTo G_error

'supprime les données contenues dans la feuille de calcul
With Cells
.ClearContents
.Interior.ColorIndex = xlNone
.Font.Bold = False
End With

Cells(1, 1).Value = "Fichier"
j = 1
With Application.FileDialog(msoFileDialogFilePicker)
.Show
.Title = "Sélectionnez le(s) fichier(s)"
.AllowMultiSelect = True
For z = 1 To .SelectedItems.Count
Chemin = .SelectedItems(z)
j = j + 1

'Créer une instance de l'objet
Set Wd = New Word.Application
With Wd
'Empêche Word de s'afficher à l'ouverture
.Visible = False
.Documents.Open (Chemin)
'Place les valeurs et le nom des colonnes contenues dans Word dans la feuille Excel.
Cells(j, 1).Value = .Documents.Application.ActiveDocument.Name
For i = 2 To .ActiveDocument.Fields.Count
'si le nom de la colonne est différent, alors on la signale en rouge
If (j > 2) And (Cells(1, i).Value <> .ActiveDocument.Fields(i).Result.Bookmarks.Item(1).Name) Then
With Cells(1, i).Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
End If

Cells(1, i).Value = .ActiveDocument.Fields(i).Result.Bookmarks.Item(1).Name
Cells(j, i).Value = .ActiveDocument.Fields(i).Result
Next i

'Ferme le document Word
.Quit False
End With
Set Wd = Nothing
Next z
End With

G_error:
Set Wd = Nothing

End Sub