[CDR 2025] БАЗА ДАННЫХ

evkyzv

Участник
Топикстартер
Сообщения
3
Реакции
0
Здравствуйте, у меня есть база в EXCEL (прикрепил фото), как можно перенести штрих код (картинка) в COREL DRAW автоматически, слияние при печати только текст получается а картинки не получается
 

Вложения

  • Снимок экрана 2025-09-10 135944.png
    Снимок экрана 2025-09-10 135944.png
    185.2 КБ · Просм.: 35
Только штрих-коды, без всякой привязки к инфе? А дальше что делать планируется?
Можно удалить остальные колонки, сгенерить pdf и импортировать его в корел, например. Только какой в этом смысл?
 
Только штрих-коды, без всякой привязки к инфе? А дальше что делать планируется?
Можно удалить остальные колонки, сгенерить pdf и импортировать его в корел, например. Только какой в этом смысл?
штрих коды к привязки к инфе надо, просто приходиться потом отдельно штрих код вставлять после того как сгенерировал pdf и импортировал его в корел
 

Вложения

  • Снимок экрана 2025-09-10 141826.png
    Снимок экрана 2025-09-10 141826.png
    139.6 КБ · Просм.: 29
ну так и нужно задачу описывать
 
 
  • Спасибо
Реакции: Realalex и lmn1
Бывали карты дисконтные чтоб номер и штрих-код к нему привязанный.

Номер в Excel > PrintMerge Corel > PDF
Штрих код в Excel (в смысле цифры шрихкода) > Barcode Creator > PDF

Потом плагином для Акробат Quite Imposing слеплял страницы обоих PDF (1я к 1й, 2я к 2й...).

Докер зачетный от Деревяшкина на видео. Ранее не знал о таком.
 
Последнее редактирование:
  • Спасибо
Реакции: DukereD
Когда-то, давным-давно, для создания пропусков я использовал вот такой скрипт. Можно попытаться использовать его как основу
Код:
Private Sub NamesSpaces2Return(ByRef sString As String)
    ' Функция заменяет пробелы в ФИО людей на CR
    Const sSpace = " "
    Dim nPos1, nPos2 As Integer
    Dim sTemp As String
    Dim sCR As String
    sCR = Chr(13)
    nPos1 = InStr(sString, sSpace)
    nPos2 = InStr(nPos1 + 1, sString, sSpace)
    sTemp = Mid(sString, 1, nPos1 - 1) & sCR & Mid(sString, nPos1 + 1, nPos2 - nPos1) & sCR & Mid(sString, nPos2 + 1, Len(sString) - nPos2)
    sString = sTemp
End Sub

Private Sub AnalizeDDDString(ByVal sInpString As String, ByRef sTabNum As String, ByRef sName As String, ByRef sDolznost As String, ByRef sOtdel As String, ByRef sFotoName As String)
    ' разбор строки для пропусков ддда
    ' знак разделитель полей в строке
    Const sDivider = ";"
    Dim nCurrPos As Integer
   
    ' найдем первое поле - табельный номер
    ' он стоит до первого разделителя
    nCurrPos = InStr(sInpString, sDivider)
    ' выдернем строку с табельным номером
    sTabNum = Left(sInpString, nCurrPos - 1)
    ' из исходной строки удалим табельный номер и разделитель
    nCharCount = Len(sInpString) - nCurrPos
    sInpString = Right(sInpString, nCharCount)

   
    ' найдем второе поле - ФИО
    ' он стоит до первого разделителя
   nCurrPos = InStr(sInpString, sDivider)
    ' выдернем строку с ФИО
    sName = Left(sInpString, nCurrPos - 1)
    NamesSpaces2Return sName
    ' из исходной строки удалим ФИО и разделитель
    nCharCount = Len(sInpString) - nCurrPos
    sInpString = Right(sInpString, nCharCount)
   
    ' третье поле - должность
    ' он стоит до первого разделителя
    nCurrPos = InStr(sInpString, sDivider)
    ' выдернем строку с должностью
    sDolznost = Left(sInpString, nCurrPos - 1)
    ' из исходной строки удалим должность и разделитель
    nCharCount = Len(sInpString) - nCurrPos
    sInpString = Right(sInpString, nCharCount)

   
    ' четвертое поле - отдел
    ' он стоит до первого разделителя
    nCurrPos = InStr(sInpString, sDivider)
    ' выдернем строку с отделом
    sOtdel = Left(sInpString, nCurrPos - 1)
    ' из исходной строки удалим отдел и разделитель
    nCharCount = Len(sInpString) - nCurrPos
    sInpString = Right(sInpString, nCharCount)

   
    ' все что осталось - это имя файла с фотографией
    sFotoName = sInpString
End Sub
Private Sub AddFoto(sFotoName As String, FotoShape As Shape)
    ' импортирует фотку с именем файла sFotoName и размещает ее
    Dim OldFoto As Shape
    Dim NewFoto As Shape
    Dim dX As Double, dY As Double, dWidth As Double, dHeight As Double

    ' получим размеры и положение старой фотки
    FotoShape.GetBoundingBox dX, dY, dWidth, dHeight
    ' импортиреум фотку
    ActiveLayer.Import (sFotoName)
    Set NewFoto = ActiveSelectionRange(1)
    ' поставим ее на место
   
    NewFoto.SetBoundingBox dX, dY, dWidth, dHeight, True
 ' поменяем разрешение картинки - проверка!!!!
    NewFoto.Bitmap.Resample 0, 0, True, 300, 300
   
   
    ' удалим старую со страницы
    FotoShape.Delete
   
End Sub



'расстановка фотографий и данных для пропусков ООО СК ддд
Public Sub zpxDDDIDCards()
    '
    ' Recorded 8.06.2009
    '
    ' Description:
    '
    ' открытие и чтение файла данных
    Const BasePath = "e:\Мои документы\ддд\пропуск 06.09\"
    Const textFileName = BasePath & "Имена ддд.txt"
    Const PhotoDir = "E:\Мои документы\ддд\пропуск 06.09\22mod\"
    Const TextTabNum = "tabnum"
    Const TextName = "name"
    Const TextDolznost = "dolznost"
    Const TextOtdel = "otdel"
    Const TextFoto = "foto"
   
    Dim fs, f, s
    ' Dim textFile As Textstream
   
    Dim OrigSelection As ShapeRange
    Dim BaseShape As Shape
    Dim currPage As Page
    Dim NewPageRange As ShapeRange
    Dim sTabNum As String, sName As String, sDolznost As String, sOtdel As String, sFoto As String
   
    Dim sCurrText As String
   
    Set fs = CreateObject("Scripting.FileSystemObject")
     
    Set textFile = fs.OpenTextFile(textFileName) ' , ForReading, False)
    'ActivePage.Shapes.All.CreateSelection
    'ActivePage.ActiveLayer.Shapes.All.Cut
        Set OrigSelection = ActiveSelectionRange
    If OrigSelection.count > 0 Then
    ActiveDocument.BeginCommandGroup ("Пропуска на ддд")
   
    ' цикл чтения текстового файла
     
    Do While textFile.AtEndOfStream <> True
        sCurrText = textFile.ReadLine
        ActiveDocument.AddPages (1)
        OrigSelection.CopyToLayer ActivePage.ActiveLayer
               
        AnalizeDDDString sCurrText, sTabNum, sName, sDolznost, sOtdel, sFoto
       
        For Each BaseShape In ActiveLayer.SelectableShapes
        ' прочтем строку
           
        ' выбираем страницу
            Select Case BaseShape.Name
                Case TextTabNum
                    BaseShape.Text.Story = sTabNum
                Case TextName
                    BaseShape.Text.Story = sName
                Case TextDolznost
                    BaseShape.Text.Story = sDolznost
                Case TextOtdel
                    BaseShape.Text.Story = sOtdel
                Case TextFoto
                    AddFoto PhotoDir & sFoto, BaseShape
            End Select
         Next
     Loop
     ActiveDocument.EndCommandGroup
    textFile.Close
    End If
End Sub
Оно, правда, старое, как отходы жизнедеятельности мамонта, но, если есть желание, покопайте, может, наткнетесь на ценные мысли.
Штрих код вполне можно импортировать как картинку, придумать, как именовать и вперед
 
  • Спасибо
Реакции: evkyzv
Если у вас разовая акция, не морочьте себе голову и делайте через pdf, как выше советовали, быстрее будет. Если постоянная, то заморачивайтесь с программированием
 
Если у вас разовая акция, не морочьте себе голову и делайте через pdf, как выше советовали, быстрее будет. Если постоянная, то заморачивайтесь с программированием
к сожалению постоянная
 
А там точно CorelDraw нужен? Вот из этого, например, не подойдет?
 
Последнее редактирование:
Я Print Shop вспомнил, Print Mall придумал, а вместе их свести не получилось :)
 
Здравствуйте, у меня есть база в EXCEL (прикрепил фото), как можно перенести штрих код (картинка) в COREL DRAW автоматически, слияние при печати только текст получается а картинки не получается
я бы сделал так:
1. Эксель переименовываем в ZIP, открываем как архив и в папке media находим все картинки.
image1.png . image100.png
1757572978762.png

2. Сохраняем их в папку
3. В экселе в столбце вместо картинок вставляем путь к ним, благо имена файлов идет по порядку их расположения в Экселе.
1757573114042.png

4. И уже слиянием печати - вставляем картинку
1757573133001.png
 
  • Спасибо
Реакции: zollinger, ~RA~ и Chiga