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