VBA Macro to create text goes missing when I try to print.

*Update*
So after a few days of troubleshooting and trying to figure out what the problem was, I just decided to continue working like was doing before. I guess powerclipping the objects together and and saving the document embeds the font correctly. I just open the file again and print. Ugh. Thanks everyone for the help!

I made a macro to create a pricing text lockup. Everything looks good in Corel, but when I try to print to my rip software, the text is missing.

If I edit the text, like changing the price from 12 to 13, the 13 shows up again in the rip. It's like Corel loads the correct font again for printing when I edit it? Not sure what is happening.

Video explanation - https://youtu.be/LjcRBMPMAHw

Here's my messy code. (sorry)

Private Sub Make_Click()
  Dim Dlr As Shape
  Dim Cnt As Shape
  Dim Sym As Shape
  Dim Tax As Shape
  Dim Pk As Shape
  Dim Price As Shape
  Dim TwoFor_2 As Shape
  Dim TwoFor_For As Shape
  Dim TextType As String
  Dim X As Double, Y As Double, w As Double, h As Double
  Const space_dist As Double = 0.1
  Dim sr As New ShapeRange
  Dim sr2 As New ShapeRange
  Dim FF_Brand As String

  Dim sT As Shape
  Dim pa As Shape
  Dim PrPk As Shape
  Dim PackArt As Shape
  Dim PriceFinal As Shape
  Dim PackArtDesc As Shape
  
  On Error GoTo ErrHndler
  'BeginCommandGroup "Error Handling"
  
  Set Dlr = ActiveLayer.CreateArtisticText(0, 0, PriceFrm.Dollar.Value, , , BrandFont.Value, 100)
  Set Cnt = ActiveLayer.CreateArtisticText(0, 0, PriceFrm.Cents.Value, , , BrandFont.Value, 50)
  Set Sym = ActiveLayer.CreateArtisticText(0, 0, "$", , , BrandFont.Value, 50)
  Set Tax = ActiveLayer.CreateArtisticText(0, 0, PriceFrm.Tax_Options.Value, , , BrandFont.Value, 9, , , , cdrCenterAlignment)
        
  'Cent Position
  Cnt.AlignToShape cdrAlignTop, Dlr
  Cnt.LeftX = Dlr.RightX + space_dist
  
  '$ Position
  Sym.AlignToShape cdrAlignTop, Dlr
  Sym.RightX = Dlr.LeftX - 0.07
  
  'Tax Position
  Cnt.GetBoundingBox X, Y, w, h
  Tax.SetSize w
  Tax.AlignToShape cdrAlignHCenter, Cnt
  Tax.TopY = Cnt.BottomY - 0.07
  
  '2 For Position
  Select Case TwoFor
    Case True
    Set TwoFor_2 = ActiveLayer.CreateArtisticText(0, 0, "2", , , BrandFont.Value, 70)
    Set TwoFor_For = ActiveLayer.CreateArtisticText(0, 0, "For", , , BrandFont.Value, 50)
    
    '2 Position
    TwoFor_2.AlignToShape cdrAlignTop, Dlr
    TwoFor_2.RightX = Sym.LeftX - 0.12
    
    'For Position
    TwoFor_2.GetBoundingBox X, Y, w, h
    TwoFor_For.SetSize w
    TwoFor_For.CenterX = TwoFor_2.CenterX
    TwoFor_For.AlignToShape cdrAlignBottom, Dlr
    
  End Select
  
  'Select & Group Price
  sr.Add Dlr
  sr.Add Cnt
  sr.Add Sym
  sr.Add Tax
  
  Select Case TwoFor
    Case True
    sr.Add TwoFor_2
    sr.Add TwoFor_For
  End Select
  
  sr.Group.Name = "$" & PriceFrm.Dollar.Value & "." & PriceFrm.Cents.Value
  sr.GetBoundingBox X, Y, w, h
  
  Set Price = ActivePage.FindShape(Name:="$" & PriceFrm.Dollar.Value & "." & PriceFrm.Cents.Value)
  
  'Add Package
  If Pk_MultiPage.Value = 0 Then 'Standard
  Set Pk = ActiveLayer.CreateArtisticText(0, 0, Pk_Options_Std.Value, , , BrandFont.Value, 9, , , , cdrCenterAlignment)
  Pk.SetSize w
  Pk.CenterX = sr.Group.CenterX
  Pk.TopY = sr.Group.BottomY - 0.1
  Pk.Name = Pk_Options_Std.Value
  
    Else
    If Pk_MultiPage.Value = 1 Then 'Stacked
    Set Pk = ActiveLayer.CreateArtisticText(0, 0, Pk_Options_Stk.Value, , , BrandFont.Value, 9, , , , cdrCenterAlignment)
    Pk.SetSize w
    Pk.CenterX = sr.Group.CenterX
    Pk.TopY = sr.Group.BottomY - 0.1
    Pk.Text.Story.LineSpacing = 73.638
    Pk.Name = Pk_Options_Std.Value
  
        Else
        If Pk_MultiPage.Value = 2 Then 'Narrow
        Set Pk = ActiveLayer.CreateArtisticText(0, 0, Pk_Options_Nw.Value, , , BrandFont.Value, 9, , , , cdrCenterAlignment)
        Pk.Text.Story.LineSpacing = 73.638
        Pk.SetSize , Dlr.SizeHeight
        Pk.LeftX = sr.Group.RightX + 0.15
        Pk.CenterY = sr.Group.CenterY
        Pk.Name = Pk_Options_Std.Value
        
        End If
    End If
  End If
  
  'Group and Rename
  ActiveLayer.Shapes(2).AddToSelection
  ActiveSelection.Group.Name = "Price" '"$" & PriceFrm.Dollar.Value & "." & PriceFrm.Cents.Value
  Set PrPk = ActivePage.FindShape(Name:="Price")
  
  'Text Brand Colors v2
  Select Case BrandFont.Value

    Case "Bud Bold", "TradeGothic", "Futura Md BT"
        ActiveSelection.Fill.UniformColor.CMYKAssign 75, 68, 65, 90 'Black
        
    Case "Gotham Bold"
        ActiveSelection.Fill.UniformColor.CMYKAssign 100, 87, 0, 20 'Ultra Blue
        
    Case "Trade Gothic LT Std Bold"
        ActiveSelection.Fill.UniformColor.CMYKAssign 100, 96, 26, 21 'Estrella Blue
        
    Case "TitlingGothicFB Comp Medium"
        ActiveSelection.Fill.UniformColor.CMYKAssign 75, 35, 0, 0 'Bud Light Blue
        
    Case Else
        'Put code here to do something if it is none of the above.
        
  End Select
  
  'Activate Price Layer
  'ActivePage.FindShape(Name:="Price Area").CreateSelection
  'Set sT = ActiveSelection


  'ActivePage.ActiveLayer..CenterX = sT.CenterX
  Set pa = ActivePage.FindShape(Name:="Price Area")
  pa.GetBoundingBox X, Y, w, h
  
  ActiveSelection.SetSize w * 90 / 100
  
  ActiveSelection.CenterX = pa.CenterX
  
  ActiveSelection.TopY = pa.TopY - 95 / 100
  
  'Dim Price1 As Shape
  'Set Price1 = ActivePage.FindShape(Name:="Price")
  'ActiveSelection.TopY = Price1.BottomY - 10
  
  
  'Package Placement Options==============================================
  Select Case Pk_Below1
    Case True
    'MsgBox FlexFrm.Brand.Value
    'MsgBox PriceFrm.Pk_Options_Stk.Value
    'MsgBox "D:\Sync\Source Art\" & FlexFrm.Brand.Value & "\Package Art\Automate\" & PriceFrm.Pk_Options_Std.Value & ".cdr"
    PrPk.GetBoundingBox X, Y, w, h
    ActiveLayer.Import "D:\Sync\Source Art\" & FlexFrm.Brand.Value & "\Package Art\Automate\" & PriceFrm.Pk_Options_Std.Value & ".cdr"
    Application.Refresh
    Set PackArt = ActivePage.FindShape(Name:=PriceFrm.Pk_Options_Std.Value & ".cdr")
    ActiveSelection.SetSize w
    ActiveSelection.CenterX = PrPk.CenterX
    ActiveSelection.TopY = PrPk.BottomY - 1.5
    
    sr.Add PrPk
    sr.Add PackArt
    sr.CreateSelection
    sr.Group.Name = PriceFrm.Pk_Options_Std.Value & " - Final"
    ActiveDocument.ClearSelection
    ActivePage.FindShape(Name:=PriceFrm.Pk_Options_Std.Value & " - Final").CreateSelection
    Set PriceFinal = ActivePage.FindShape(Name:=PriceFrm.Pk_Options_Std.Value & " - Final")
    
    pa.GetBoundingBox X, Y, w, h
    PriceFinal.SetSize , h - 2
    ActiveSelection.CenterX = pa.CenterX
    ActiveSelection.CenterY = pa.CenterY
  End Select
  
  Select Case Pk_Below2
    Case True
    'MsgBox FlexFrm.Brand.Value
    'MsgBox PriceFrm.Pk_Options_Stk.Value
    'MsgBox "D:\Sync\Source Art\" & FlexFrm.Brand.Value & "\Package Art\Automate\" & PriceFrm.Pk_Options_Std.Value & ".cdr"
    'ActivePage.FindShape(Name:=PriceFrm.Pk_Options_Std.Value).CreateSelection
    Pk.Text.Replace Pk_Options_Std.Value, Pk_Options_Stk.Value, False, ReplaceAll:=True 'Change Pack Style
    PrPk.GetBoundingBox X, Y, w, h
    ActiveLayer.Import "D:\Sync\Source Art\" & FlexFrm.Brand.Value & "\Package Art\Automate\" & PriceFrm.Pk_Options_Std.Value & ".cdr"
    Application.Refresh
    Set PackArt = ActivePage.FindShape(Name:=PriceFrm.Pk_Options_Std.Value & ".cdr")
    ActiveSelection.SetSize w
    ActiveSelection.CenterX = PrPk.CenterX
    ActiveSelection.TopY = PrPk.BottomY - 1.5
    
    PackArt.GetBoundingBox X, Y, w, h
    Pk.SetSize h - 3
    Pk.LeftX = PackArt.RightX + 3
    Pk.CenterY = PackArt.CenterY
    Price.CenterX = PackArt.CenterX
    PrPk.Ungroup
    
    Set PackArtDesc = ActivePage.FindShape(Name:=PriceFrm.Pk_Options_Std.Value)
    Price.GetBoundingBox X, Y, w, h
    ActiveDocument.ClearSelection
    sr2.Add PackArtDesc
    sr2.Add PackArt
    sr2.CreateSelection
    ActiveSelection.SetSize w
    ActiveSelection.TopY = Price.BottomY - 1.5
    
    sr2.Add Price
    sr2.CreateSelection
    
    pa.GetBoundingBox X, Y, w, h
    ActiveSelection.SetSize , h - 2
    ActiveSelection.CenterX = pa.CenterX
    ActiveSelection.CenterY = pa.CenterY

  End Select
  
  Select Case Pk_Side1
    Case True
    Pk.Text.Replace Pk_Options_Stk.Value, Pk_Options_Std.Value, False, ReplaceAll:=True 'Change Pack Style
    PrPk.GetBoundingBox X, Y, w, h
    ActiveLayer.Import "D:\Sync\Source Art\" & FlexFrm.Brand.Value & "\Package Art\Automate\" & PriceFrm.Pk_Options_Std.Value & ".cdr"
    Application.Refresh
    Set PackArt = ActivePage.FindShape(Name:=PriceFrm.Pk_Options_Std.Value & ".cdr")
    PackArt.SetSize , h
    PackArt.CenterY = PrPk.CenterY
    PackArt.LeftX = PrPk.RightX + 2
    
    ActiveDocument.ClearSelection
    sr2.Add PrPk
    sr2.Add PackArt
    sr2.CreateSelection

    pa.GetBoundingBox X, Y, w, h
    ActiveSelection.SetSize w - 2
    ActiveSelection.CenterX = pa.CenterX
    ActiveSelection.CenterY = pa.CenterY
  End Select
  
  Select Case Pk_Side2
    Case True
    Pk.Text.Replace Pk_Options_Stk.Value, Pk_Options_Std.Value, False, ReplaceAll:=True 'Change Pack Style
    Price.GetBoundingBox X, Y, w, h
    ActiveLayer.Import "D:\Sync\Source Art\" & FlexFrm.Brand.Value & "\Package Art\Automate\" & PriceFrm.Pk_Options_Std.Value & ".cdr"
    Application.Refresh
    
    Set PackArt = ActivePage.FindShape(Name:=PriceFrm.Pk_Options_Std.Value & ".cdr")
    PackArt.SetSize , h
    PackArt.CenterY = Price.CenterY
    PackArt.LeftX = PrPk.RightX + 2
    
    PrPk.Ungroup
    ActiveDocument.ClearSelection
    ActivePage.FindShape(Name:="$" & PriceFrm.Dollar.Value & "." & PriceFrm.Cents.Value).CreateSelection
    sr.Add PackArt
    sr.CreateSelection
    
    ActiveSelection.GetBoundingBox X, Y, w, h
    
    Set PackArtDesc = ActivePage.FindShape(Name:=PriceFrm.Pk_Options_Std.Value)
    PackArtDesc.SetSize w
    PackArtDesc.TopY = ActiveSelection.BottomY - 2
    
    sr.Add PackArtDesc
    sr.CreateSelection
    
    pa.GetBoundingBox X, Y, w, h
    ActiveSelection.SetSize w - 2
    ActiveSelection.CenterX = pa.CenterX
    ActiveSelection.CenterY = pa.CenterY
  End Select
  
  Select Case Pk_Side3
    Case True
    Pk.Text.Replace Pk_Options_Stk.Value, Pk_Options_Std.Value, False, ReplaceAll:=True 'Change Pack Style
    Price.GetBoundingBox X, Y, w, h
    ActiveLayer.Import "D:\Sync\Source Art\" & FlexFrm.Brand.Value & "\Package Art\Automate\" & PriceFrm.Pk_Options_Std.Value & ".cdr"
    Application.Refresh
    
    Set PackArt = ActivePage.FindShape(Name:=PriceFrm.Pk_Options_Std.Value & ".cdr")
    PackArt.SetSize , h
    PackArt.CenterY = Price.CenterY
    PackArt.LeftX = PrPk.RightX + 2
    
    PrPk.Ungroup
    
    PackArt.GetBoundingBox X, Y, w, h
    
    Set PackArtDesc = ActivePage.FindShape(Name:=PriceFrm.Pk_Options_Std.Value)
    PackArtDesc.SetSize w
    PackArtDesc.CenterX = PackArt.CenterX
    PackArtDesc.TopY = PackArt.BottomY - 2
    
    ActiveDocument.ClearSelection
    sr2.Add PackArt
    sr2.Add PackArtDesc
    sr2.CreateSelection
    
    Price.GetBoundingBox X, Y, w, h
    sr2.SetSize , h
    sr2.Add Price
    sr2.CreateSelection
    
    pa.GetBoundingBox X, Y, w, h
    ActiveSelection.SetSize w - 2
    ActiveSelection.CenterX = pa.CenterX
    ActiveSelection.CenterY = pa.CenterY
  End Select
  
  Select Case Pk_Side4
    Case True
    Pk.Text.Replace Pk_Options_Std.Value, Pk_Options_Nw.Value, False, ReplaceAll:=True 'Change Pack Style
    Price.GetBoundingBox X, Y, w, h
    ActiveLayer.Import "D:\Sync\Source Art\" & FlexFrm.Brand.Value & "\Package Art\Automate\" & PriceFrm.Pk_Options_Std.Value & ".cdr"
    Application.Refresh
    
    Set PackArt = ActivePage.FindShape(Name:=PriceFrm.Pk_Options_Std.Value & ".cdr")
    PackArt.SetSize , h
    PackArt.CenterY = Price.CenterY
    PackArt.LeftX = PrPk.RightX + 2
    
    PrPk.Ungroup
    
    PackArt.GetBoundingBox X, Y, w, h
    
    Set PackArtDesc = ActivePage.FindShape(Name:=PriceFrm.Pk_Options_Std.Value)
    PackArtDesc.SetSize , h
    PackArtDesc.LeftX = PackArt.RightX + 2
    PackArtDesc.CenterY = PackArt.CenterY
    
    ActiveDocument.ClearSelection
    sr2.Add PackArt
    sr2.Add PackArtDesc
    sr2.Add Price
    sr2.CreateSelection

    pa.GetBoundingBox X, Y, w, h
    ActiveSelection.SetSize w - 2
    ActiveSelection.CenterX = pa.CenterX
    ActiveSelection.CenterY = pa.CenterY
  End Select

Exit Sub
  
ErrHndler:
  MsgBox "Error occured: " & Err.Description
  Err.Clear
  Exit Sub
  
End Sub

Top Replies

Eskimo 6 months ago in reply to Jamie Chestnut +1

Fonts are an aspect of CorelDRAW about which I know very little - especially when it comes to TrueType, OpenType, embedding, working with a font that isn't installed, etc. Without deeper understanding...

Parents

0 Mek 6 months ago

I would try to save file and then send to fiery for print.

NB. Of course converting to curves before sending to print can help
Cancel
Up 0 Down

Reply

Verify Answer

Cancel

0 Jamie Chestnut 6 months ago in reply to Mek

Corel keeps flagging my comments with my youtube links. And I can't post images either.

I tried saving and that didn't work. I simplified my code to just place text with my brand fonts and only a few go through.

Option Explicit

Private Sub CreateTextTest()
    

    Dim Font As Shape
    
    'Optimize True
    
    Set Font = ActiveLayer.CreateArtisticText(0.5, 1, "Gotham Bold", cdrEnglishUS, , "Gotham Bold", 50) 'Prints!
    Set Font = ActiveLayer.CreateArtisticText(0.5, 2, "TitlingGothicFB Comp Medium", , , "TitlingGothicFB Comp Medium", 50) 'Blank
    Set Font = ActiveLayer.CreateArtisticText(0.5, 3, "Bud Bold", , , "Bud Bold", 50) 'Blank
    Set Font = ActiveLayer.CreateArtisticText(0.5, 4, "Trade Gothic LT Std Bold", , , "Trade Gothic LT Std Bold", 50) 'Blank
    Set Font = ActiveLayer.CreateArtisticText(0.5, 5, "TradeGothicNo.20-Condensed", , , "TradeGothicNo.20-Condensed", 50) 'Blank
    Set Font = ActiveLayer.CreateArtisticText(0.5, 6, "Futura Md BT", , , "Futura Md BT", 50) 'Prints!
    Set Font = ActiveLayer.CreateArtisticText(0.5, 7, "Suti", , , "Suti", 50) 'Prints!
    Set Font = ActiveLayer.CreateArtisticText(0.5, 8, "GoodOT-CondBold", , , "GoodOT-CondBold", 50) 'Blank
    
    Set Font = Nothing
    
    'Optimize False
    
End Sub

Sub Optimize(Use As Boolean)
    If Use Then
        EventsEnabled = False
        Optimization = True
        ActiveDocument.SaveSettings
    Else
        ActiveDocument.RestoreSettings
        EventsEnabled = True
        Optimization = False
        ActiveWindow.Refresh
    End If
End Sub

0 Mek 6 months ago in reply to Jamie Chestnut

Try to check the font embedding permission
Cancel
Up 0 Down

Reply

Verify Answer

Cancel
0 Jamie Chestnut 6 months ago in reply to Mek

I added their embedability status to the code.

Here's what prints out. https://imgur.com/3rpG1Tn
Cancel
Up 0 Down

Reply

Verify Answer

Cancel

Reply

0 Mek 6 months ago in reply to Jamie Chestnut

try to check postscript print options (compatibility, font downloading)

NB: cannot insert file to post - getting error
Cancel
Up 0 Down

Reply

Verify Answer

Cancel

Children

0 Jamie Chestnut 6 months ago in reply to Mek

Did you try to attach a screenshot? It didn't get uploaded. Can you share an Imgur link?

Print dialog - https://imgur.com/5FWqrML

Print options - https://imgur.com/JPPcTMT
Cancel
Up 0 Down

Reply

Verify Answer

Cancel