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!!!
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