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 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101
|
Const wdStory = 6
Const wdMove = 0
Const wdBorderLeft = -2, _
wdBorderRight = -4, _
wdBorderTop = -1, _
wdBorderBottom = -3, _
Dim objWordSource, documentObjWordSource
Dim objWordDest, documentObjWordDest, objSelectionDest
Set objWordSource = CreateObject("Word.Application")
Set objWordDest = CreateObject("Word.Application")
' don't display any messages about documents needing to be converted from old Word file formats
objWordSource.DisplayAlerts = 0
objWordDest.DisplayAlerts = 0
' open the Word document as read-only ; open (path, confirmconversions, readonly)
objWordSource.Documents.Open <sourceFile>, false, true
objWordDest.Documents.Open <destFile>, false, false
Set documentObjWordSource = objWordSource.Documents(1)
Set documentObjWordDest = objWordDest.Documents(1)
Dim bandeauMoisAnnee, dateCompleteDuJour
bandeauMoisAnnee = "NOVEMBRE 2014"
dateCompleteDuJour = "mercredi 19 novembre 2014"
' Positionnement du bandeau
Set objSelectionDest = objWordDest.Selection
objSelectionDest.EndKey wdStory, wdMove
objSelectionDest.TypeParagraph()
objSelectionDest.TypeParagraph()
objSelectionDest.Font.Size = "11"
objSelectionDest.Font.Name = "Times New Roman"
objSelectionDest.Font.Bold = True
objSelectionDest.ParagraphFormat.Alignment = 1 'centre
objSelectionDest.Borders.Enable = True
objSelectionDest.TypeText bandeauMoisAnnee
objSelectionDest.TypeParagraph()
objSelectionDest.ClearFormatting
objSelectionDest.ParagraphFormat.Alignment = 0 'gauche
objSelectionDest.Borders(wdBorderBottom).Visible = False
objSelectionDest.Borders(wdBorderLeft).Visible = False
objSelectionDest.Borders(wdBorderRight).Visible = False
objSelectionDest.Borders(wdBorderTop).Visible = False
Set objSelectionDest = Nothing
' on insère la date du jour
Set objSelectionDest = objWordDest.Selection
objSelectionDest.EndKey wdStory, wdMove
objSelectionDest.TypeParagraph()
objSelectionDest.TypeText dateCompleteDuJour
objSelectionDest.TypeParagraph()
Set objSelectionDest = Nothing
Dim table, ligne
Dim dateSign, typeEtabSign, nomEtabSign, communeSign
For Each table In documentObjWordSource.Tables
For ligne = 1 To table.Rows.Count
dateSign = table.Cell(ligne, 1).Range.Text
typeEtabSign = table.Cell(ligne, 2).Range.Text
nomEtabSign = table.Cell(ligne, 3).Range.Text
communeSign = table.Cell(ligne, 4).Range.Text
If dateSign <> "" And Instr(LCase(dateSign), "date") = 0 Then
Set objSelectionDest = objWordDest.Selection
If ((ligne Mod 2) > 0) Then
' Cas d'une nouvelle rubrique
objSelectionDest.EndKey wdStory, wdMove
objSelectionDest.TypeParagraph()
objSelectionDest.TypeParagraph()
objSelectionDest.TypeText "Groupement " & ligne & " : "
objSelectionDest.TypeParagraph()
End If
documentObjWordSource.Range(table.Cell(ligne, 1).Range.Start, table.Cell(ligne, 4).Range.End).Select.Copy
objSelectionDest.Paste
Set objSelectionDest = Nothing
End If
End If
Next
Next
' Close the document
documentObjWordSource.Close
documentObjWordDest.Close
' Free memory used to store the document object
Set documentObjWordSource = Nothing
Set documentObjWordDest = Nothing
objWordSource.Quit
Set objWordSource = Nothing
objWordDest.Quit
Set objWordDest = Nothing |
Partager