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
| Sub obsevcopy()
'macro pour exporter les observations
Dim osba As String
Dim i As Integer, f As Integer
Application.DisplayStatusBar = True
Application.StatusBar = "Traitement en cours..."
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Application.Visible = False
On Error GoTo handler
'Documents("Transmission.docm").Activate
For i = 2 To 62 Step 2
For f = 1 To 61 Step 2
If ActiveDocument.Tables(2).Cell(Row:=i, Column:=1).Range.Text = Chr(13) & Chr(7) Then Resume Next
ActiveDocument.Tables(2).Cell(Row:=i, Column:=1).Range.Copy
Selection.Copy
ChangeFileOpenDirectory CFileosb & Left(ActiveDocument.Tables(2).Cell(Row:=f, Column:=1).Range, (Len(ActiveDocument.Tables(2).Cell(Row:=f, Column:=1).Range) - 2)) & "\Notes\"
Documents.Open FileName:="Observation de " & Left(ActiveDocument.Tables(2).Cell(Row:=f, Column:=1).Range, (Len(ActiveDocument.Tables(2).Cell(Row:=f, Column:=1).Range) - 2)) & ".docm"
Selection.InsertDateTime DateTimeFormat:="dddd d MMMM yyyy", InsertAsField _
:=False, DateLanguage:=wdFrench, CalendarType:=wdCalendarWestern, _
InsertAsFullWidth:=False
Selection.TypeParagraph
Selection.PasteAndFormat (wdFormatOriginalFormatting)
ActiveDocument.save
'ActiveDocument.Close
Next f
Next i
handler:
Resume Next
'Application.Visible = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Longue suite d'opérations !"
Application.DisplayStatusBar = False
End Sub |
Partager