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 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142
| ' Ouverture du 1er Fichier Pour Copier Son Contenu Dans un Autre il contient une entête
ChangeFileOpenDirectory "E:\Donnees_Notaire\Fichier_Doc\Formalite\"
Documents.Open FileName:="mod_forme.doc", ConfirmConversions:=False, _
ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="", _
DocumentDirection:=wdRightToLeft
ActiveDocument.SaveAs FileName:="source.doc", FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
' Ouverture du Fichier Principal qui contient un tableau de deux colonnes
' son centenu est dans la colonne de Gauche l'autre colonne est vide
' Je selectionne un certaine nombre de lignes
ChangeFileOpenDirectory "E:\Donnees_Notaire\Fichier_Doc\Actes_Etablis\"
Documents.Open FileName:="Destination.doc", ConfirmConversions:=False, _
ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="", _
DocumentDirection:=wdRightToLeft
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.HomeKey Unit:=wdStory
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=4, Extend:=wdExtend
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveDown Unit:=wdLine, Count:=24, Extend:=wdExtend
Selection.Copy
' J'ouvre le fichier de déstination je crée un tableau de Deux colonne
' avec les mêmes paramètres du tableau que j'ai selectionner auparavant
' Je colle ma selection dans la colonne de gauche
ChangeFileOpenDirectory "E:\Donnees_Notaire\Fichier_Doc\Formalite\"
Documents.Open FileName:="08582020.doc", ConfirmConversions:=False, _
ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="", _
DocumentDirection:=wdRightToLeft
Selection.EndKey Unit:=wdStory
Selection.TypeParagraph
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _
2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
With Selection.Tables(1)
If .Style <> "Grille du tableau" Then
.Style = "Grille du tableau"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
End With
Selection.Tables(1).Select
Selection.Tables(1).Rows.LeftIndent = CentimetersToPoints(0.29)
Selection.Tables(1).PreferredWidthType = wdPreferredWidthPoints
Selection.Tables(1).PreferredWidth = CentimetersToPoints(16)
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Selection.Columns.PreferredWidth = CentimetersToPoints(12.25)
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Selection.Columns.PreferredWidth = CentimetersToPoints(4)
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.PasteAndFormat (wdPasteDefault)
ActiveDocument.Save
' je revient au fichier Source pour une Nouvelle Selection
' a partir de l'endroit ou je me suis arréte
ChangeFileOpenDirectory "E:\Donnees_Notaire\Fichier_Doc\Actes_Etablis\"
Documents.Open FileName:="08582020.doc", ConfirmConversions:=False, _
ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="", _
DocumentDirection:=wdRightToLeft
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.HomeKey Unit:=wdLine
Selection.MoveDown Unit:=wdLine, Count:=43, Extend:=wdExtend
Selection.Copy
' J'ouvre le fichier de déstination je crée un tableau de Deux colonne
' avec les mêmes paramètres du tableau que j'ai selectionner auparavant
' Je colle ma selection dans la colonne de Droite
ChangeFileOpenDirectory "E:\Donnees_Notaire\Fichier_Doc\Formalite\"
Documents.Open FileName:="08582020.doc", ConfirmConversions:=False, _
ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="", _
DocumentDirection:=wdRightToLeft
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.TypeParagraph
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _
2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
With Selection.Tables(1)
If .Style <> "Grille du tableau" Then
.Style = "Grille du tableau"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
End With
Selection.Tables(1).Select
Selection.Tables(1).Rows.LeftIndent = CentimetersToPoints(-2.71)
Selection.Tables(1).PreferredWidthType = wdPreferredWidthPoints
Selection.Tables(1).PreferredWidth = CentimetersToPoints(16)
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Selection.Columns.PreferredWidth = CentimetersToPoints(4)
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Selection.Columns.PreferredWidth = CentimetersToPoints(12.25)
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Selection.PasteAndFormat (wdPasteDefault)
ActiveDocument.Save
ActiveDocument.Close
ActiveDocument.Close
End Sub |
Partager