Extraire word vba

Signaler
Messages postés
4
Date d'inscription
mardi 15 avril 2008
Statut
Membre
Dernière intervention
18 avril 2008
-
Messages postés
672
Date d'inscription
mercredi 22 janvier 2003
Statut
Membre
Dernière intervention
2 juin 2016
-
Bonjour,

Je voudrais écrire une macro qui me permette de faire des copy / paste automatique de paragraphes de document .doc.


Plus précisément, l'idée serait d'avoir en entrée de la macro une liste de .doc. La macro permettrait de repérer une chaine de caractères à l'intérieur de ces documents, puis de copier / coller le paragraphe suivant cette chaine de caractère à l'intérieur d'un fichier en sortie (soit un .doc, ou une page html par exemple).


Merci par avance,

9 réponses

Messages postés
672
Date d'inscription
mercredi 22 janvier 2003
Statut
Membre
Dernière intervention
2 juin 2016
1
Bonjour

Sous toute réserve du code écrit directement ici à la volée sans vérification dans VB : à tester en pas à pas (mode debug)

Une liste de doc: faire les sélections au moyen d'un formulaire comportant un DriveListbox une DirListbox , des boutons "ajouter","Supprimer", une listbox "List1" qui contiendra les chemins complets des fichiers sur lesquels porteront les traitements, et une textbox de la chaine à trouver suivi d'un bouton "cmdChercher" qui lancera la routine CopierParagrapheSiChaineDansDocument en fonction des fichiers présents dans la listbox de sélection

Dim oWrd as Object
'------
Public Sub cmdChercher()
Dim i as integer
Dim sMonFichier as String

sMonFichier= "C:\MonFichierDeSortie.txt"

Call CreerInstanceWord
' créer le fichier de sortie
Open sMonFichier For Output as #1
Close #1

For i=0 to List1.Listcount-1
   CopierParagrapheSiChaineDansDocument(List1.List(i),sMonFichier)
Next
Set oWrd= Nothing
End Sub
'------
Public Sub CreerInstanceWord()
On Error Resume Next
Set oWrd = GetObject(, "Word.Application")
If Err.Number <> 0 Then
     Set oWrd = CreateObject("Word.Application")
End If
Err.Clear    ' Efface l'objet Err au cas où une erreur s'est produite.
End Sub
'------
Public Sub CopierParagrapheSiChaineDansDocument(nomDuDocument as string, sOut as string, bOrigine as Boolean)
Dim para as Document.Paragraph
Dim Trouve as Boolean

Trouve=False
open sOut for Append as #1
oWrd.Documents.Open nomDuDocument, ReadOnly:=True
for each para in ActiveDocument.paragraphs
   If intr(para.text,ChaineARechercher) then
      if Trouve=False and bOrigine=True then 
      ' la première fois , garde une trace du nom du document d'origine
         print#1,nomDuDocument
        Trouve=True
      End if
      print #1, ActivementDocument.para.text
  End if
Close #1
oWrd.Documents(nomDuDocument).Close SaveChanges:=No 
End Sub
Messages postés
4
Date d'inscription
mardi 15 avril 2008
Statut
Membre
Dernière intervention
18 avril 2008

Bonjour loulou69,
Merci pour ta reponse.


Je suis entrain de tester ta proposition, mais j'obtiens une erreur de compil sur les lignes de code suivantes. Apparement le type "Document.Paragraph" n'existe pas, mais je ne sais pas par quoi le remplacer. J'ai également essayé de remplacer intr par InStr, mais cela ne fonctionne pas (cela vient probablement du fait que "para" n'est pas correctement défini).


Dim para as Document.Paragraph
...
If intr(para.text,ChaineARechercher) then

Désolée pour ces questions probablement triviales mais je suis débutante en vb. Merci par avance.
Messages postés
672
Date d'inscription
mercredi 22 janvier 2003
Statut
Membre
Dernière intervention
2 juin 2016
1
Bonjour

C'est bien Instr : tu as trouvé
If inStr(para.text,ChaineARechercher)<>0 then
Ajouter différent de 0 (<>0) ce sera mieux

pour les paragraphes ,ne pas préfixer avec Document

Dim oPara as Paragraph
Messages postés
672
Date d'inscription
mercredi 22 janvier 2003
Statut
Membre
Dernière intervention
2 juin 2016
1
Bonjour

C'est bien Instr : tu as trouvé
If inStr(para.text,ChaineARechercher)<>0 then
Ajouter différent de 0 (<>0) ce sera mieux

pour les paragraphes ,ne pas préfixer avec Document

Dim oPara as Paragraph
Messages postés
4
Date d'inscription
mardi 15 avril 2008
Statut
Membre
Dernière intervention
18 avril 2008

Bonjour Loulou69,<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /??>





Merci bc pour ta réponse.





J’ai modifié le programme de la manière suivante, et j’arrive à présent à extraire un paragraphe d’un document et le copier dans un autre.





(l’implémentation n’est surement pas très élégante pour le moment… les conseils sont les bienvenus).





La recherche dans le document sur la chaine de caractère ne fonctionne pas correctement (partie en bleue).





… et je ne maitrise pas non plus le copy / paste de paragraphe.





Il me reste donc à implémenter les 3 points suivants :






1) Identifier une section donnée dans un document par exemple “2.1 Définition” (Tous les documents en input suivent un template identique)







2) COPIER l’intégralité de la section (jusqu’au début de la section suivante 2.2)







3) COLLER dans le document en output le contenu de la section préalablement COPIEE (en 2).







(Si possible à l’intérieur d’une section déjà définie 3.2…)






Merci par avance,






 







 






Sub cmdExtract2()






 






Dim oPara As Paragraph





Dim Trouve As Boole
an





Dim oWord As Word.Application





Set oWord = New Word.Application





'Set visibility to true to test and debug





oWord.Visible = True





oWord.ChangeFileOpenDirectory "C:\... "






 






' DOCUMENT EN INPUT pour extraire les infos





oWord.Documents.Open FileName:="InputDocument.doc", ConfirmConversions:= _






    
   

False, ReadOnly:=True, AddToRecentFiles:=False, PasswordDocument:="", _






        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _






       

WritePasswordTemplate:="", Format:=0






       







Trouve = False





For Each oPara In oWord.ActiveDocument.Paragraphs






1) Identifier la section “4.1 Définition” d’un document (Tous les documents en input suivent un template identique)







   If InStr(oPara.Text, "2.1 Definition") <> 0 Then






     

If Trouve = False Then






        Trouve = True






      End If






2) COPIER l’intégralité de la section (jusqu’au début de la section suivante 4.2)







      oWord.ActiveDocument.Paragraphs… ??     






  End If






 




 








oWord.Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="1"









oWord.Selection.Find.ClearFormatting










 










    With oWord.Selection.Find










        .Text = "Overview"










        .Forward = True










        .Wrap = wdFindContinue










       

.Format = False










        .MatchCase = False










        .MatchWildcards = True 'Pour accepter les recherches avec expressions régulières










   

End With










 










    oWord.Selection.Find.Execute










    oWord.Selection.Find.Execute










    oWord.Selection.MoveRight unit:=wdCharacter, Count:=2










    oWord.Selection.MoveDown unit:=wdLine, Count:=55, Extend:=wdExtend










    oWord.Selection.Copy










    oWord.Selection.WholeStory










    MsgBox "Paragraph is extracted"








 






oWord.ActiveDocument.Close






 






' DOCUMENT EN OUTPUT pour extraire les infos





oWord.Documents.Open FileName:="DocVide.doc", ConfirmConversions:= _






        False, ReadOnly:=True, AddToRecentFiles:=False, PasswordDocument:="", _






        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _






        WritePasswordTemplate:="", Format:=0






 






oWord.Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="1"





oWord.Selection.WholeStory





oWord.Selection.PasteAndFormat (wdPasteDefault)






 







3) COLLER dans le document en output le contenu de la section préalablement COPIEE (en 2).







(Si possible à l’intérieur d’une section déjà définie 3.2…)






MsgBox "Paragraph is paste into output document"






 






oWord.ActiveDocument.SaveAs FileName:="MonFichierDeSortie.doc", _






    FileFormat:=0, LockComments:=False, Password:="", _






    AddToRecentFiles:=True, WritePassword:="", _






    ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _






    False, SaveNativePictureFormat:=False, _






    SaveFormsData:=False, _






    SaveAsAOCELetter:=False





oWord.ActiveDocument.Close





oWord.Quit





Set oWord = Nothing






 






End Sub
Messages postés
672
Date d'inscription
mercredi 22 janvier 2003
Statut
Membre
Dernière intervention
2 juin 2016
1
si on peut faire sujet par sujet :
la manipulation des sections

Dim sec As Section
Dim str as String

For Each sec In ActiveDocument.Sections
str= sec.Range.Text
Next

Pour la recherche dans le texte, moi j'utilise la fonction Find.Execute aussi comme toi mais j'ai souvent rencontré des problèmes de fiabilité du code avec les MoveLeft ...

Donc j'utilise parfois les expression régulières, quelques mines d'informations
http://www.microsoft.com/france/scripting/
http://regexlib.com/CheatSheet.aspx
http://www.regexp.org
http://regexadvice.com

Function IsValidNumber(sTo As String, Optional bFloat As Boolean = False) As Boolean
Const RegNombre = "[-|+][0-9]*[.|/][0-9]+"
Const RegNum = "[0-9]+" ' 1 ou plusieurs chiffre de 0 à 9
Dim sPattern As String: Dim bValid As Boolean
   sPattern = RegNum
   If bFloat Then sPattern = RegNombre
   bValid = ValidExp(sTo, sPattern)
   If bMsgValid Then MsgBox IIf(bValid, "valid", "invalid") & vbCrLf & sTo
   IsValidNumber = bValid
End Function

' Return true if expression match with pattern
Private Function ValidExp(sExp As String, sPattern As String) As Boolean
   'Dim MyRegExp As RegExp
   Dim myMatches As Object 'MatchCollection


   'Set MyRegExp = New RegExp
   InitRegExp
   oRegExp.pattern = sPattern
   oRegExp.IgnoreCase = True
   oRegExp.Global = False
   Set myMatches = oRegExp.Execute(sExp)   ValidExp (myMatches.Count 1)
   Set myMatches = Nothing
   Set oRegExp = Nothing
 End Function
Messages postés
672
Date d'inscription
mercredi 22 janvier 2003
Statut
Membre
Dernière intervention
2 juin 2016
1
j'ai oublié les déclarations

Public oRegExp 'As Object 'RegExp
Public clsMatchCol As Object 'MatchCollection
Public bMsgValid As Boolean
Public myRegExp As RegExp
Public myMatches As MatchCollection
Public myMatch As Match

et une petite fonction

Function InitRegExp()
Set oRegExp = CreateObject("VBScript.RegExp")
bMsgValid = True
End Function
Messages postés
4
Date d'inscription
mardi 15 avril 2008
Statut
Membre
Dernière intervention
18 avril 2008

Bonjour,
Je sens que je progresse, et que je m'approche du résultat attendu, mais cependant, j'ai encore qqs pbs: je n'arrive tjrs pas à manipuler et utiliser les sections dans word.
L'utilisation des expressions régulières semble être une bonne piste ... mais le compilateur ne reconnait pas le type RegExp (notamment dans la déclaration : Public myRegExp As RegExp).
Sais tu comment je pourrais contourner le pb, et modifier la déclaration pour que cela fonctionne.
Autrement, existe t-il un autre moyen de vérifier si une chaine de caractère est présente dans un intitulé de section (qui correspond à la variable "str" définie ci-dessous, n'est ce pas?). Donc en utilisant ce que tu proposais:
For each sec In ActiveDocument.Sections
   str = sec.Range.Text
Next
Merci par avance.
Messages postés
672
Date d'inscription
mercredi 22 janvier 2003
Statut
Membre
Dernière intervention
2 juin 2016
1
pour la déclaration de type pour myRegExp  tu peux sans problème l'enlever comme je l'ai fait sur la variable oRegExp

tu peux manipuler une selection soit avec l'objet prédéfini Selection soit avec un objet range

Dim oRange as Range
Set oRange = Selection.Range.Text

Pour les sections

sec.range.select 
ou
sec.range.copy
ou
ActiveDocument.Section(NumSection).Range.Select