Controler Word à partir d'excel --> remplacer ^p

claire_la_geek

XLDnaute Nouveau
Bonjour,

J'espère que tout le monde va bien! Je sollicite votre grandeur et puissance dans le domaine qui me fait galérer depuis 24h.
Voilà ce que je dois faire au final:
renvoyer le résultat de cases à cocher (surement multiples réponses), dans Notepad, chaque réponse séparée par une virgule.
DOnc voilà cmment j'ai procédé:
1) récupération de case à cocher avec link cell OK
2) si TRUE (donc case cochée), alors à côté j'ai le texte de la case qui s'affiche OK
3) advanced filter pour obtenir toutes les réponses les unes en dessous des autres OK
4) copier/coller de cette liste dans word OK
5) convert to text, séparée par ^p OK
6)remplacer ^p par ,. et là ECHEC! j'ai mon code qui me fait bugguer et fermer excel, au moment de cette action
je vous joins tout mon code pour la partie word

merki de votre aide!!!

Code:
Sub transfertVersWord()
    Dim DocWord As Word.Document
 
    Dim AppWord As Word.Application
    Dim derl As Integer
    Set AppWord = New Word.Application
    Application.DisplayAlerts = True
    AppWord.ShowMe
    AppWord.Visible = True
    'Ouvre le document Word
    Set DocWord = AppWord.Documents.Add
    'recherche de la dernière ligne du tableau
    ThisWorkbook.Worksheets("to keep").Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.copy
    ' Colle les données dans Word
    DocWord.Range.PasteSpecial
    Application.CutCopyMode = False
    DocWord.Select
    AppWord.Selection.HomeKey Unit:=wdStory, Extend:=wdMove
    AppWord.Selection.Rows.ConvertToText Separator:=wdSeparateByParagraphs, _
        NestedTables:=True
    DocWord.Select
     AppWord.Selection.Find.ClearFormatting
    AppWord.Selection.Find.Replacement.ClearFormatting
    With AppWord.Selection.Find
        .Text = "^p"
        .Replacement.Text = ","
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.copy
   Shell "notepad", vbNormalFocus
Selection.Paste
        End Sub
 

Pièces jointes

  • EDM ChecklistOLD.xlsm
    194.1 KB · Affichages: 48

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
314 628
Messages
2 111 337
Membres
111 104
dernier inscrit
JEMADA