[XL-2013] Problème macro qui BOUCLE sans raison

1 pièce(s) jointe(s)

Problème macro qui BOUCLE sans raison

Bonjour à toutes et à tous,
Mon problème est le suivant :
Je souhaite exporter une plage contenue dans une feuille Excel, vers un nouveau document WORD prenant en compte les macros Word.
Ma plage se nomme : « TxT_EXPORT ».
Pour se faire j’ai copié plusieurs macros trouvées sur la toile.
• Sub Excel_Word()
• Sub Excel_Word02()
• Sub Passage_Excel_Word()
• Sub EnvoyerTableauxExcelVersWord_V02()
Chaque macros se relance dès que le code arrive à la ligne suivante :

oWdApp.Selection.Paste

A PARTIR DE CETTE LIGNE UNE BOUCLE S'INSTALLE

Je ne comprends pas pourquoi pouvez-vous m’aider ?
Mes codes sont brouillons suite à des modifications brouillonnes.
Je vous prie de m’en excuser.
Merci d’avance pour votre aide.
En PJ un fichier exemple.

Bonjour,

Il aurait été bien que tu copie tes macros ici directement (dans des balises CODE bien entendu ;) ) car peu de gens sont disposés à ouvrir des fichiers joints ;)

Bonjour à toutes et à tous,

le code fonctionne au lancement normal mais se met en BOUCLE au pas à pas (F8).
Dés que le programme à effectué une boucle il faut quitter excel pour pouvoir le relancer sans problème sinon il copie indéfiniment le texte sur des documents WORD.
Incompréhensible
Merci d'avoir consulté cette question très brouillonne.

Première MACRO (au pas à pas avec F8 après exécution de la ligne 33 la boucle s'installe et on repart de la ligne 1)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Sub Excel_Word()
 
Dim oWdApp As Word.Application
Dim oWdDoc As Word.Document
'Lancer une instance Word
Set oWdApp = CreateObject("Word.Application")
 
'Ouvrir un nouveau document
Set oWdDoc = oWdApp.Documents.Add
'Rendre Word visible
oWdApp.Visible = True
 
  If oWdApp.Selection.PageSetup.Orientation = wdOrientPortrait Then
    oWdApp.Selection.PageSetup.Orientation = wdOrientLandscape
  Else
    oWdApp.Selection.PageSetup.Orientation = wdOrientPortrait
  End If
  Sheets("MSG TL").Select
'Détermine la plage contenant des valeurs
ld = [MSG_TL].Find("*", LookIn:=xlValues, _
    SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
cd = [MSG_TL].Find("*", LookIn:=xlValues, _
    SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column
LF = [MSG_TL].Find("*", LookIn:=xlValues, _
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
cf = [MSG_TL].Find("*", LookIn:=xlValues, _
    SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
 
'Copier une plage depuis Excel
ActiveSheet.Range(Cells(ld, cd), Cells(LF, cf)).Copy
 
'Coller la plage dans Word
oWdApp.Selection.Paste
'oWdApp.ActiveWindow.ActivePane.VerticalPercentScrolled = 0
'oWdApp.Selection.Tables(1).AutoFitBehavior AutoFitWindow
 
Application.CutCopyMode = False
 
End Sub

Deuxième MACRO (au pas à pas avec F8 après exécution de la ligne 22 la boucle s'installe et on repart de la ligne 1)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub Excel_Word02()
 
Dim oWdApp As Word.Application 'Object '
Dim oWdDoc As Word.Document 'Object '
 
'Lancer une instance Word
Set oWdApp = CreateObject("Word.Application")
 
'Ouvrir un nouveau document
Set oWdDoc = oWdApp.Documents.Add
 
'Rendre Word visible
oWdApp.Visible = True
 
 
  Sheets("MSG TL").Select
 
'Copier une plage depuis Excel
ActiveSheet.Range("MSG_TL").Copy
 
'Coller la plage dans Word
oWdApp.Selection.Paste
oWdDoc.Tables(1).AutoFitBehavior wdAutoFitWindow
 
Application.CutCopyMode = False
 
End Sub

Troisième MACRO (au pas à pas avec F8 après exécution de la ligne 30 la boucle s'installe et on repart de la ligne 1)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Sub Passage_Excel_Word()
 Dim AppWord As New Word.Application
 Dim DocWord As New Word.Document
' Il faut créer un nouveau document Word dans l'application Word
 With AppWord
   .Visible = True
  Set DocWord = .Documents.Add
   .Activate
 End With
'Dans Word on ajoute une ligne de titre avec une mise en forme
 With AppWord.Selection
   .TypeText Text:="Chiffre d'affaire 2003"
   .HomeKey Unit:=wdLine
   .EndKey Unit:=wdLine, Extend:=wdExtend
  .ParagraphFormat.Alignment = wdAlignParagraphCenter
   .Font.Size = 18
   With .Font
   .Name = "Arial"
   .Size = 16
   .Bold = True
   End With
'Copier le tableau Excel dans le presse papier
  Sheets("MSG TL").Select
ActiveSheet.Range("MSG_TL").Copy
 
  ' Coller le tableau dans Word avec liaison
  'DocWord.Selection.Paste
 .EndKey Unit:=wdLine
  .TypeParagraph
  .PasteSpecial Link:=True, DataType:=wdPasteOLEObject, Placement:=wdInLine, DisplayAsIcon:=False
'Copier le graphique Excel dans le presse papier
 ' ActiveSheet.ChartObjects(1).Activate
  'ActiveChart.ChartArea.Select
 'ActiveChart.ChartArea.Copy
'Coller le graphique dans Word
  ' .TypeParagraph
   '.Paste
 End With
'Enregistrer le document Word
 With DocWord
  .SaveAs ThisWorkbook.Path & "\ca_2003.doc", Allowsubstitutions:=True
'Dans Word Aperçu avant impression du résultat
    '.PrintPreview
'Réinitialiser l'objet
  Set AppWord = Nothing
 End With
End Sub

Quatrième MACRO (au pas à pas avec F8 après exécution de la ligne 24 la boucle s'installe et on repart de la ligne 1)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Sub EnvoyerTableauxExcelVersWord_V02()
'necessite d'activer la reference Microsoft Word xx.x Object Library
Dim DocWord As Word.Document
Dim AppWord As Word.Application
'Dim DebMSG As String
Dim FinMSG As String
Dim Plage As String
 
Application.ScreenUpdating = False
Application.EnableEvents = False
 
 
 Sheets("MSG TL").Select
 
'DebMSG = [E13].Select
FinMSG = "E" & Range("E600").End(xlUp).Row
 'DernLigne = Range("A" & Rows.Count).End(xlUp).Row
Plage = "E13" & ":" & FinMSG
Set AppWord = New Word.Application
AppWord.Visible = True
Set DocWord = AppWord.Documents.Add
Range(Plage).Copy
 
AppWord.Selection.Paste
 
 
Application.CutCopyMode = False
 
DocWord.Tables(1).AutoFitBehavior wdAutoFitWindow
 Set AppWord = Nothing
 
Application.ScreenUpdating = True
Application.EnableEvents = True
 
 
End Sub

Bonjour,

en général travailler avec Selection est source d'erreur, surtout quand l'objet n'est même pas actif ‼

Avant chaque ligne provoquant le souci, tenter ceci : AppActivate AppWord.Caption …

Sinon exposer le problème dans le bon forum, vu que cela concerne Word !

__________________________________________________________________________________________

Merci de cliquer sur :plusser: pour chaque message ayant aidé puis sur :resolu: pour clore cette discussion …