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
  • 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.

    Have you considered including that text in a document that you would use as a template for this job? That shape would already have the correct font, color, etc.

    The only things you would need to do then for a specific job (and which might be done by VBA) would be:

    1. Change the text in that text shape to reflect the name of the person.
    2. Reposition the shape (perhaps not even necessary if the text shape had justification to keep it aligned on one end).
    3. Convert the shape to curves if your process requires that.

    If you give the text shape a specific name in the template, then you can use that name to access that text shape by VBA.

Reply Children