Macro word en macro excel

Bonjour à tous

Voilla j'ai crée une macro word afin de fussionnée des lignes fractionnées.

Par la suite j'ai essayé de l'ajouter à ma macro excel pour qu'il fasse ces fussions depuis excel.

Malheureusement je doit me tromper dans la syntaxe du SET car il tourne en boucle dessus car la variable myCellsn est vide.

Desoler mais le code est un peu gros donc j'ai enlevé les déclarations.

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
 
 
'ouvrir le document Word
Set docWord = appWord.Documents.Open(pathDocWord)
 
Dim Msg, Style, Style5, Title, Help, Ctxt, Response, Response2, Response3, Response4, Response5, MyString
Response5 = MsgBox("Le chemin du fichier est:  " & pathDocWord, Style5, Title, Help, Ctxt)
Dim NbTABLE As Integer
Dim xx As Integer
Dim Nombre_de_table_a_importee As String
Dim strFileName As String, strPathName As String
'Traitement des cellules fussionnées
    'redimention des colonnes et des lignes
 
 
    For xx = 1 To docWord.Tables.Count
 
      On Error Resume Next
 
    'traitement des titre et des cellules fussionnés
    'tant qu il y a des cellules dans le tableau
 
    'calcule le nombre de cellules
       ctr = docWord.Tables(xx).Range.Cells.Count
       ctrt = 0
 
    'si term est trouver
    If (StrComp(text_trim_paragraph(docWord.Tables(xx).Range.Cells(1).Range.Text), tabtitre(0)) = 0) Then
      Dim myCellsn As Range
      'titre manquant
      For cc = 1 To ctr
 
     'si un titre n'est pas attendu
     If (StrComp(UCase(text_trim_paragraph(docWord.Tables(xx).Range.Cells(cc).Range.Text)), UCase(text_trim_paragraph(tabtitre(ctrt)))) <> 0) Then
 
 
 
 
      If (StrComp(UCase(text_trim_paragraph(docWord.Tables(xx).Range.Cells(cc).Range.Text)), UCase(text_trim_paragraph(tabtitre(ctrt + 1)))) = 0) Then
         'gestion du dernier champ "licence"
         If (ctrt < 21) Then
         Set myCellsn = docWord.Range(Start:=docWord.Tables(xx).Range.Cells(cc).Range.Start, End:=docWord.Tables(xx).Range.Cells(cc).Range.End)
         myCellsn.Rows.Select
         Selection.InsertRowsAbove 1
         Selection.TypeText Text:=l_list_champ(ctrt)
         Selection.MoveRight Unit:=wdCharacter, Count:=1
         Selection.TypeText Text:="N.A."
         End If
         ctrt = ctrt + 1
         cc = cc + 1
      End If
 
        If (StrComp(UCase(text_trim_paragraph(docWord.Tables(xx).Range.Cells(cc - 1).Range.Text)), UCase(text_trim_paragraph(tabtitre(ctrt - 1)))) <> 0) Then
           'MsgBox (UCase(text_trim_paragraph(ActiveDocument.Tables(xx).Range.Cells(cc - 1).Range.Text & UCase(text_trim_paragraph(tabtitre(ctrt - 1))))))
 
     Set myCellsn = docWord.Range(Start:=docWord.Tables(xx).Range.Cells(cc - 1).Range.Start, End:=docWord.Tables(xx).Range.Cells(cc).Range.End)
         myCellsn.Select
         Selection.Cells.Split NumRows:=1, NumColumns:=1, MergeBeforeSplit:=True
           'Correction compteur
           cc = cc - 1
 
          End If
 
     Else
     'Correction compteur pour passer au titre suivant
      ctrt = ctrt + 1
     cc = cc + 1
     End If
 
    Next cc
    End If
 
    Next xx

Merci d'avance de votre aide

J'ai résolu le problème. il faut remplacer les set

avec

Code:

1
2
3
4
 
 
appWord.ActiveDocument.Tables(xx).Range.Cells(cc).Select
           appWord.Selection.InsertRowsAbove 1

Code:

1
2
3
4
 
   appWord.ActiveDocument.Tables(xx).Range.Cells(cc).Select
            appWord.Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
            appWord.Selection.Cells.Split NumRows:=1, NumColumns:=1, MergeBeforeSplit:=True

c'est du bidoullage mais sa marche