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
| Sub CopyDocProps()
'
' CopyDocProps Macro
'
'
Dim dp() As DocumentProperty
Dim CustomPropCount As Integer
Dim i As Integer
Dim intResponse As Integer
If Windows.Count > 2 Then
MsgBox "Il y a trop de docmuments Word ouverts. SVP " & _
"Fermez les autres documents Word et relancez la macro.", , _
"Trop de Documents Word ouverts !"
Exit Sub
End If
intResponse = MsgBox("Créer la facture ? " & Chr(10) & "Fermez les autres documents Word au préalable si vous souhaitez récupérer les propriétés du document.", _
vbYes, "Création facture")
If intResponse = vbYes Then Selection.EndKey Unit:=wdStory
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
Selection.Copy
Documents.Add Template:= _
"D:\Téléchargements\IR\FACTURES\FACTURE FR 2018.dotx" _
, NewTemplate:=False, DocumentType:=0
Selection.PasteAndFormat (wdPasteDefault)
Selection.HomeKey Unit:=wdStory
Application.Run MacroName:="NextWindow"
If intResponse = vbCancel Then ActiveDocument.Close
CustomPropCount = ActiveDocument.CustomDocumentProperties.Count
ReDim dp(1 To CustomPropCount)
For i = 1 To CustomPropCount
Set dp(i) = ActiveDocument.CustomDocumentProperties(i)
Next i
Application.Run MacroName:="NextWindow"
For i = 1 To CustomPropCount
If dp(i).LinkToContent = True Then
ActiveDocument.CustomDocumentProperties.Add _
Name:=dp(i).Name, _
LinkToContent:=True, _
Value:=dp(i).Value, _
Type:=dp(i).Type, _
LinkSource:=dp(i).LinkSource
Else
ActiveDocument.CustomDocumentProperties.Add _
Name:=dp(i).Name, _
LinkToContent:=False, _
Value:=dp(i).Value, _
Type:=dp(i).Type
End If
Next i
MsgBox "La facture vient d'être créée."
Exit Sub
Err_Handler:
' if Word raises an error, then allow the user
' to update the custom document property
intResponse = MsgBox("Les propriétés de Documents (" & _
dp(i).Name & ") exitent déjà." & vbCrLf & vbCrLf & _
"Voulez-vous actualiser les champs?", vbYesNoCancel, _
"Création facture")
Select Case Response
Case vbCancel
End
Case vbNo
ActiveDocument.CustomDocumentProperties(dp(i).Name).Value _
= dp(i).Value
Resume Next
Case vbYes
Resume Next
End Select
End Sub |
Partager