Автонумерация и дублирование.

[a.shaferov]

Здравствуйте!

Делаем гардеробные номерки, которые потом режутся из пластика лазером.
Из одного макета надо получить прямоугольник m*n номерков, с определенным расстоянием между ними, все на одной странице.
Естественно каждый номерок со своим номером.

Надублировать их не проблема, а вот менять текст - достаточно муторно и есть вероятность опечататься.
Можно ли это как нибудь автоматизировать?

Спасибо!

 

[lev]

Ответ: Автонумерация и дублирование.

Посмотрите тут.

 

[a.shaferov]

Ответ: Автонумерация и дублирование.

Спасибо!

Print Merge, как я понимаю не катит, т.к. в результате надо .cdr и все в кривых, которое пойдет на лазер, а вот про VBA посмотрю...

 

[a.shaferov]

Ответ: Автонумерация и дублирование.

Скрипт на VBA в принципе вариант неплохой, если его допилить, жаль что я не знаю VBA...

 

[a.shaferov]

Ответ: Автонумерация и дублирование.

Вот:

Private Sub GoButton_Click()
    Dim myIndexNumber As Integer
    Dim myWrd As TextRange
    Dim mySh As Shape
    Dim mySelR, myDubl As ShapeRange
    Set mySelR = ActiveSelectionRange
    For i = 1 To NumeratorForm.NumOfObj.Text Step 1
        If NumeratorForm.HVCheckBox.Value = 1 Then
            Set myDubl = ActiveSelectionRange.StepAndRepeat(1, NumeratorForm.StepSize.Text, 0, cdrModeSpacing, cdrRight, cdrModeNoOffset, cdrDown)
        Else
            Set myDubl = ActiveSelectionRange.StepAndRepeat(1, 0, NumeratorForm.StepSize.Text, cdrModeNoOffset, cdrRight, cdrModeSpacing, cdrDown)
        End If
        If Not myDubl.Shapes.FindShapes(Type:=cdrTextShape).Count = 0 Then
            For Each sh In myDubl.Shapes.FindShapes(Type:=cdrTextShape)
                For Each myWrd In sh.Text.Story.Words
                    If IsNumeric(Trim(myWrd.Text)) Then myWrd.Text = Trim(Str(Val(myWrd.Text) + i))
                Next
  
            Next
        Else
            MsgBox "There are no numbers!"
        End If
        Set mySelR = myDubl
    Next i
End Sub

На данный момент 2 проблемы:
- Не понятно как для StepAndRepeat указать что расстояние в миллиметрах. Там стоит 1, но это явно не 1 мм.
- При указании количества объектов больше 1 все ложатся друг на друга, без отступа...

 

[Realalex]

Ответ: Автонумерация и дублирование.

Спасибо!

Print Merge, как я понимаю не катит, т.к. в результате надо .cdr и все в кривых, которое пойдет на лазер, а вот про VBA посмотрю...

Начиная с версии X4 в меню Print Merge точно есть кнопочка, позволяющая создать новый cdr файл, где всё уже разложено как надо после Импозера.

 

[a.shaferov]

Ответ: Автонумерация и дублирование.

Ага, только:
- Корел X3
- Расклад происходит по штуке на страницу, а надо чтобы всё на одной, с заданными промежутками

 

[Realalex]

Ответ: Автонумерация и дублирование.

А Imposition Layout Tool использовать религия не позволяет?

 

[Dorm]

Ответ: Автонумерация и дублирование.


Не по теме:
В индизайне делается за несколько минут

 

[Realalex]

Ответ: Автонумерация и дублирование.

В Кореле тоже

 

[a.shaferov]

Ответ: Автонумерация и дублирование.

Макрос поправил - вот он:

Private Sub GoButton_Click()
    Dim myIndexNumber As Integer
    Dim myWrd As TextRange
    Dim mySh As Shape
    Dim mySelR, myDubl As ShapeRange
    Set mySelR = ActiveSelectionRange
    For i = 1 To NumeratorForm.NumOfObj.Text Step 1
        If NumeratorForm.HVCheckBox.Value Then
            Set myDubl = mySelR.StepAndRepeat(1, NumeratorForm.StepSize.Text / 25.4, 0, cdrModeSpacing, cdrRight, cdrModeNoOffset, cdrDown)
        Else
            Set myDubl = mySelR.StepAndRepeat(1, 0, NumeratorForm.StepSize.Text / 25.4, cdrModeNoOffset, cdrRight, cdrModeSpacing, cdrDown)
        End If
        If Not myDubl.Shapes.FindShapes(Type:=cdrTextShape).Count = 0 Then
            For Each sh In myDubl.Shapes.FindShapes(Type:=cdrTextShape)
                For Each myWrd In sh.Text.Story.Words
                    If IsNumeric(Trim(myWrd.Text)) Then myWrd.Text = Trim(Str(Val(myWrd.Text) + i))
                Next
            Next
        Else
            MsgBox "There are no numbers!"
        End If
        Set mySelR = myDubl
    Next i
End Sub

Все оказывается просто. Единственно я так и не разобрался как сделать чтобы размеры были в мм вместо дюймов. Просто размер в мм делю на 25.4, но это не лучшее решение, т.к. получается с долями...

А теперь вопрос:
У меня получилась форма + вышеприведенный код, который просто сохраняется с документом.
Возможно ли (и как) на панель корела добавить кнопку для быстрого вызова?
Чтобы это было доступно для всех документов и чтобы не надо было каждый раз лазить в редактор VB для запуска.

 

[lev]

Ответ: Автонумерация и дублирование.

Впишите в начале кода:
ActiveDocument.Unit=cdrMillimeter
Кнопка - Tools>Customization>Commands>Macros - и вытаскиваете куда надо (но это уже в данной теме офтопик, дальнейшие вопросы - отдельной темой)