Extraire word vba

Question

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,

cs_loulou69 · Answer

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

cs_vstephen · Answer

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.

cs_loulou69 · Answer

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

cs_loulou69 · Answer

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

cs_vstephen · Answer

Bonjour Loulou69, 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

cs_loulou69 · Answer

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

cs_loulou69 · Answer

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

cs_vstephen · Answer

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.

cs_loulou69 · Answer

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

Extraire word vba

9 réponses

Votre réponse

Discussions similaires