Sub CDR_CMX_CDR()
Dim myNewDoc As Document
Dim myOldDoc As Document
Dim p As Page
Dim sNameFile As String
Dim optt As New StructSaveAsOptions
Set myOldDoc = ActiveDocument
Set myNewDoc = Application.CreateDocument()
For Each p In myOldDoc.Pages
p.Activate
myOldDoc.Export "d:\temp.cmx", cdrCMX6, cdrCurrentPage
myNewDoc.AddPagesEx(1, p.SizeWidth, p.SizeHeight).Activate
ActivePage.Layers.Top.Import "d:\temp.cmx", cdrCMX6
Next p
myNewDoc.Pages(1).Delete
sNameFile = myOldDoc.FilePath & myOldDoc.Title
optt.EmbedICCProfile = True
optt.EmbedVBAProject = False
optt.IncludeCMXData = True
optt.Overwrite = True
optt.Range = cdrAllPages
optt.Version = myOldDoc.SourceFileVersion
optt.Filter = myOldDoc.SourceFormat
myOldDoc.Close
VBA.FileSystem.FileCopy sNameFile, sNameFile & ".tmp"
myNewDoc.SaveAs sNameFile, optt
End Sub
