[CDR 2017-2021] Штрихкоды CorelDRAW 2020

  • Автор темы Автор темы OLGA*
  • Дата начала Дата начала
Вот что с этой проблемой делать?))
Попробуйте повесить на кнопочку один из двух макросов
1
второй в коде - отсюда
Код:
Sub BarcodeToCurves()
    Dim OrigSelection As ShapeRange, bc As ShapeRange, sx#, sy#, s1 As Shape
    ActiveDocument.BeginCommandGroup ("BARCODE")
    On Error GoTo ErrHandler
    Optimization = True
    Set bc = ActivePage.FindShapes(, cdrOLEObjectShape)
    For Each s1 In bc
    If InStr(s1.OLE.FullName, "BARCODE") Then
      s1.GetPosition sx, sy
      s1.Cut
      ActiveLayer.PasteSpecial "Metafile"
      Set pastesel = ActiveSelectionRange
      pastesel.PositionX = sx
      pastesel.PositionY = sy
      pastesel.Ungroup
      For Each s In pastesel
      If s.ZOrder = pastesel.Count Then s.Fill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 0): GoTo here
      s.Fill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 100)
      If s.Type = cdrTextShape Then s.ConvertToCurves
here:
      Next s
      pastesel.CreateSelection
      pastesel.Group
      End If
      Next s1
      Optimization = False
      ActiveDocument.EndCommandGroup
ExitSub:
Optimization = False
ActiveWindow.Refresh
Exit Sub

ErrHandler:
 MsgBox "Error occured: " & Err.Description
 Resume ExitSub
End Sub
 
  • Спасибо
Реакции: OLGA*
Попробуйте повесить на кнопочку один из двух макросов
1
второй в коде - отсюда
Код:
Sub BarcodeToCurves()
    Dim OrigSelection As ShapeRange, bc As ShapeRange, sx#, sy#, s1 As Shape
    ActiveDocument.BeginCommandGroup ("BARCODE")
    On Error GoTo ErrHandler
    Optimization = True
    Set bc = ActivePage.FindShapes(, cdrOLEObjectShape)
    For Each s1 In bc
    If InStr(s1.OLE.FullName, "BARCODE") Then
      s1.GetPosition sx, sy
      s1.Cut
      ActiveLayer.PasteSpecial "Metafile"
      Set pastesel = ActiveSelectionRange
      pastesel.PositionX = sx
      pastesel.PositionY = sy
      pastesel.Ungroup
      For Each s In pastesel
      If s.ZOrder = pastesel.Count Then s.Fill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 0): GoTo here
      s.Fill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 100)
      If s.Type = cdrTextShape Then s.ConvertToCurves
here:
      Next s
      pastesel.CreateSelection
      pastesel.Group
      End If
      Next s1
      Optimization = False
      ActiveDocument.EndCommandGroup
ExitSub:
Optimization = False
ActiveWindow.Refresh
Exit Sub

ErrHandler:
MsgBox "Error occured: " & Err.Description
Resume ExitSub
End Sub
Уууу, этот вопрос еще придется изучить, пока не умею вешать макросы))
 
пока не умею вешать макросы))
макрос делает это за одно нажатие
можно по- простому - сделали штрих код - вырезали его в буфер - далее Edit - Paste Special ... - рисунок Метафайл
потом обычным образом в eps
вот два результата обратного импорта eps - один из них вам знаком
1595599685313.png
 
макрос делает это за одно нажатие
можно по- простому - сделали штрих код - вырезали его в буфер - далее Edit - Paste Special ... - рисунок Метафайл
потом обычным образом в eps
вот два результата обратного импорта eps - один из них вам знаком
Посмотреть вложение 133960
А, т.е. всю эту процедуру запишет? Через Paste Special я пробовала, просто долго это всё, но если одной кнопкой, то норм)
 
Ваш шашечки или ехать?
Вам шрихкоды нужны или непременно Корел заставить корректно их экспортировать?
 
Ваш шашечки или ехать?
Вам шрихкоды нужны или непременно Корел заставить корректно их экспортировать?
Другим способом не знаю как делать. К тому же я не фрилансер, и у меня определенные требования как и чем это делать. Хотелось бы корел заставить)
 
Второй макрос -вылетает - поправил малость - положил в ресурсы
распаковать и положить сюда
c:\Users\*****\AppData\Roaming\Corel\CorelDRAW Graphics Suite 2020\Draw\GMS\BARCODE_to_Curve.gms
Выделенный баркод копируется в буфер и возвращается как метафайл, текст окривляется, цвета конвертируются в CMYK
назначить кнопочку или шорткат
 
Последнее редактирование:
  • Спасибо
Реакции: MrDesigner