Macro in the open event of a document not working

Hope someone can help me.  I am very new to using macros in Corel.  I have some code that was working to put some text in a specific font, size and place - i engrave personalized chopping boards so it is a repetitive task that i am hoping to automate., i have now put it into the open event of a document that contains the footprint of the chopping board and some other graphics..  However, i have a line in the code that opens the document which i no longer need as obviously the file is already open. if i comment it out the code wont run so I think i need to set the document to the active document but im not sure of the syntaxt etc.

Private Sub Document_Open()

Dim openopt As StructOpenOptions
Set openopt = CreateStructOpenOptions
With openopt.ColorConversionOptions
.SourceColorProfileList = "sRGB IEC61966-2.1,ISO Coated v2 (ECI),Dot Gain 15%"
.TargetColorProfileList = "sRGB IEC61966-2.1,ISO Coated v2 (ECI),Dot Gain 15%"
End With


Dim Person As String 'holds personalisation details

Person = InputBox("Enter Personalisation Details")

Dim d As Document
Dim s As Shape
Dim t As Text

'no longer needed as now in the open event of the document
'Set d = OpenDocumentEx("D:\Production Files\Laser\Engrave\Chopping Boards\Asda Bamboo\Cook You Must\Medium\no name.cdr", openopt)

Set d = ActiveDocument.Windows.Activate

d.ReferencePoint = cdrMiddleRight
d.CreateShapeRangeFromArray(ActiveLayer.Shapes(9), ActiveLayer.Shapes(8), ActiveLayer.Shapes(7), ActiveLayer.Shapes(6), ActiveLayer.Shapes(5), ActiveLayer.Shapes(4), ActiveLayer.Shapes(3), ActiveLayer.Shapes(2)).Stretch 1.150129, 1#

Set s = d.ActiveLayer.CreateParagraphText(-6.542988, 7.10522, -0.312563, 10.166098, Person)
Set t = s.Text
t.Story.Font = "Albertus Medium"
t.Story.Size = 72


s.ConvertToCurves
s.Move 3.73028, -1.009437
d.ReferencePoint = cdrTopLeft
s.Stretch 1.185438
Dim SaveOptions As StructSaveAsOptions
Set SaveOptions = CreateStructSaveAsOptions
With SaveOptions
.EmbedVBAProject = False
.Filter = cdrCDR
.IncludeCMXData = False
.Range = cdrAllPages
.EmbedICCProfile = True
.Version = cdrVersion22
.KeepAppearance = True
End With


d.SaveAs "D:\Production Files\Laser\Engrave\Chopping Boards\Asda Bamboo\Cook You Must\Medium\" & Person & ".cdr", SaveOptions
Dim expopt As StructExportOptions
Set expopt = CreateStructExportOptions
expopt.UseColorProfile = True
Dim expflt As ExportFilter
Set expflt = d.ExportEx("D:\Production Files\Machine Export Files\2. Flat Products\Asda Bamboo Medium " & Person & ".dxf", cdrDXF, cdrAllPages, expopt)
With expflt
.BitmapType = 0 ' FilterDXFLib.dxfBitmapJPEG
.TextAsCurves = True
.Version = 12 ' FilterDXFLib.dxfVersion2007
.Units = 4 ' FilterDXFLib.dxfCentimeters
.FillUnmapped = True
.FillColor = 0
.Finish
End With


'insert code to check file looks ok
Dim result As VbMsgBoxResult

result = MsgBox("Does it look ok?", vbYesNoCancel, "Good to close")

If result = vbYes Then
d.Close
End If
If result = vbCancel Then
End If

If result = vbNo Then
End If

End Sub

Parents Reply Children