Подставить автоматически при открытии файла текущюю дату +18 месяцев.

TheMarshal · 16.06.2007

Привет. Подскажите , как более менее автоматизирвать печать наклеек. Нужно при распечатке просталять дату после текста "Использовать до:"
Дата должна проставляться из рачета день открытия файла +18 месяцев.
Например сегодня 16.06.2007 должно поставиться 16.12.2008.

TheMarshal · 16.06.2007

Ответ: Подставить автоматически при открытии файла текушюю дату +18 месяцев.

Прочитав тему http://forum.rudtp.ru/showthread.php?t=28487 сделал пару манипуляций и получилось.

Ни когда раньше с вба не имел дела, все получилось на интуиктивном уровне.

Sub InsertFileName()
ActiveDocument.Unit = cdrMillimeter
ActiveLayer.CreateArtisticText(59.5, 6, Date + 540, , , "Arial", "5,5").Fill.ApplyUniformFill CreateRegistrationColor()
End Sub

P.S. > Спасибо wOxxOm

Подскажите, как теперь размножить наклейку на лист в кол-ве 3х6 шт. ?

wOxxOm · 17.06.2007

Ответ: Подставить автоматически при открытии файла текушюю дату +18 месяцев.

Если на странице только 1 наклейка, находящаяся в левом верхнем углу, то:

Код:

Sub InsertFileName()
   Dim sr As New ShapeRange
   ActiveDocument.BeginCommandGroup "Labels" 'чтоб undo в один шаг было
   ActiveDocument.Unit = cdrMillimeter
   ActiveLayer.CreateArtisticText(59.5, 6, Date + 540, , , "Arial", "5,5").Fill.ApplyUniformFill CreateRegistrationColor()
   sr.AddRange ActivePage.Shapes.All
   sr.Duplicate sr.SizeWidth, 0
   sr.Duplicate sr.SizeWidth * 2, 0
   sr.RemoveAll
   sr.AddRange ActivePage.Shapes.All
   sr.Duplicate 0, -sr.SizeHeight
   sr.Duplicate 0, -sr.SizeHeight * 2
   sr.Duplicate 0, -sr.SizeHeight * 3
   sr.Duplicate 0, -sr.SizeHeight * 4
   sr.Duplicate 0, -sr.SizeHeight * 5
   ActiveDocument.EndCommandGroup
End Sub

dizzy · 18.06.2007

Ответ: Подставить автоматически при открытии файла текушюю дату +18 месяцев.

wOxxOm сказал(а):
Если на странице только 1 наклейка, находящаяся в левом верхнем углу, то:...

А если не совсем, то качайте шэйпинг.... Или тайлер... А вообще-то на мой взгляд не совсем удачный вариант с выставлением даты. Как-бы все привязано к конкретным координатам. Если этикетка сдвинется или будет других параметров, то дата может шлепнутся не совсем туда куда нужно.

Я б наверное сделал привязку к текстовой строке с этой датой. Здесь наверное два пути. Либо обновлять дату выделенной строки, либо вперед метить строку, а потом обновлять не зависимо от выделения. Да и раз это необходимо делать перед печатью, то можно посадить на событие DocumentBeforePrint. А лучше на DocumentOpen.... Тогда при открытии дока будет уже светится новая дата

Если интересно, могу выложить наброски...

TheMarshal · 18.06.2007

Ответ: Подставить автоматически при открытии файла текушюю дату +18 месяцев.

wOxxOm сказал(а):
Если на странице только 1 наклейка, находящаяся в левом верхнем углу, то:

Страница сделана по размеру наклейки.

dizzy сказал(а):
А если не совсем, то качайте шэйпинг.... Или тайлер... А вообще-то на мой взгляд не совсем удачный вариант с выставлением даты. Как-бы все привязано к конкретным координатам. Если этикетка сдвинется или будет других параметров, то дата может шлепнутся не совсем туда куда нужно.

лучше на DocumentOpen.... Тогда при открытии дока будет уже светится новая дата

Если интересно, могу выложить наброски...

Очень интересно.

TheMarshal · 18.06.2007

Ответ: Подставить автоматически при открытии файла текушюю дату +18 месяцев.

Сообщение от wOxxOm
Если на странице только 1 наклейка, находящаяся в левом верхнем углу, то:

Страница сделана по размеру наклейки. В макросе можно сделать: изменение листра размера бумаги на А4, обьединение элементов наклейки в группу, перемещение наклейки в заданную точку (верхний левый, центр), добавление даты, обьединение в группу, размножение, обьединение в группу, центровка на листе, открытие окна печати (Ctrl + P) и все это запускается с открытием файла наклейки.

TheMarshal · 18.06.2007

Ответ: Подставить автоматически при открытии файла текушюю дату +18 месяцев.

Пока получилось вот, что

Код:

Sub InsertFileName()
 Dim sr As New ShapeRange
   ActiveDocument.Unit = cdrMillimeter
   ActiveLayer.CreateArtisticText(52, 6, Date + 540, , , "Arial", "8").Fill.ApplyUniformFill CreateRegistrationColor()
   ActiveDocument.MasterPage.SetSize 210#, 297#
    With ActiveDocument.MasterPage
        .Orientation = cdrPortrait
        .PrintExportBackground = True
        .Bleed = 0#
        .Background = cdrPageBackgroundNone
    End With
   sr.AddRange ActivePage.Shapes.All
   sr.Group
   sr.Duplicate 70, 0
   sr.Duplicate 70 * 2, 0
   sr.RemoveAll
   sr.AddRange ActivePage.Shapes.All
   sr.Duplicate 0, -sr.SizeHeight
   sr.Duplicate 0, -sr.SizeHeight * 2
   sr.Duplicate 0, -sr.SizeHeight * 3
   sr.Duplicate 0, -sr.SizeHeight * 4
   sr.Duplicate 0, -sr.SizeHeight * 5
   ActiveDocument.EndCommandGroup
   sr.AddRange ActivePage.Shapes.All
   sr.Group
   ActivePage.Shapes.All.AlignToPageCenter cdrAlignHCenter + cdrAlignVCenter, cdrTextAlignBoundingBox
End Sub

Как сделать, что бы макрос автоматически запускался при открытии файла и выпадало окно печати (Ctrl + P)?

dizzy · 18.06.2007

Ответ: Подставить автоматически при открытии файла текушюю дату +18 месяцев.

Там где список с формами и модулями данного макроса, чуть выше ThisMacroStorage. Туда и прописываете:

PHP:

Private Sub GlobalMacroStorage_DocumentOpen(ByVal Doc As Document, ByVal FileName As String)
InsertFileName
End Sub

Только учтите, что отныне любой файл, кой будете открывать, будет проходить через ваш макрос. Конечно это не совсем удобно. Поэтому надо поставить условие, с привязкой допустим к имени файла. Типа:

PHP:

Private Sub GlobalMacroStorage_DocumentOpen(ByVal Doc As Document, ByVal FileName As String)
If FileName = "Etiketka.cdr" Then InsertFileName
End Sub

По поводу окошка печати:

PHP:

ActiveDocument.PrintSettings.ShowDialog

TheMarshal · 18.06.2007

Ответ: Подставить автоматически при открытии файла текушюю дату +18 месяцев.

dizzy сказал(а):
Только учтите, что отныне любой файл, кой будете открывать, будет проходить через ваш макрос. Конечно это не совсем удобно. Поэтому надо поставить условие, с привязкой допустим к имени файла. Типа:

PHP:

Private Sub GlobalMacroStorage_DocumentOpen(ByVal Doc As Document, ByVal FileName As String) If FileName = "Etiketka.cdr" Then InsertFileName End Sub

А если этикеток 80 разновидностей? Как быть?
Можно сделать внутри файла, допустим, чуть выше этикетки, кнопку, которая будет запускать макрос?

wOxxOm · 18.06.2007

Ответ: Подставить автоматически при открытии файла текушюю дату +18 месяцев.

кнопку можно сделать в обычном тулбаре. Макрос разместить или в отдельном gms или внутри globalMacros.

после диалога печати можно сразу вызвать печать если не было отмены:
if ActiveDocument.PrintSettings.ShowDialog then ActiveDocument.PrintOut

TheMarshal · 18.06.2007

Ответ: Подставить автоматически при открытии файла текушюю дату +18 месяцев.

Попробовал в деле макрос

Код:

Sub InsertFileName()
 Dim sr As New ShapeRange
   ActiveDocument.Unit = cdrMillimeter
   ActiveLayer.CreateArtisticText(52, 6, Date + 540, , , "Arial", "8").Fill.ApplyUniformFill CreateRegistrationColor()
   ActiveDocument.MasterPage.SetSize 210#, 297#
    With ActiveDocument.MasterPage
        .Orientation = cdrPortrait
        .PrintExportBackground = True
        .Bleed = 0#
        .Background = cdrPageBackgroundNone
    End With
   sr.AddRange ActivePage.Shapes.All
   sr.Group
   sr.Duplicate 70, 0
   sr.Duplicate 70 * 2, 0
   sr.RemoveAll
   sr.AddRange ActivePage.Shapes.All
   sr.Duplicate 0, -sr.SizeHeight
   sr.Duplicate 0, -sr.SizeHeight * 2
   sr.Duplicate 0, -sr.SizeHeight * 3
   sr.Duplicate 0, -sr.SizeHeight * 4
   sr.Duplicate 0, -sr.SizeHeight * 5
   ActiveDocument.EndCommandGroup
   sr.AddRange ActivePage.Shapes.All
   sr.Group
   ActivePage.Shapes.All.AlignToPageCenter cdrAlignHCenter + cdrAlignVCenter, cdrTextAlignBoundingBox
   ActiveDocument.PrintSettings.ShowDialog
End Sub

Файл на печать стал 800 метров.
Долго отравляется на печать и долго подготавливается к печати. И еще достаточно сильно подгружет компьютер.

При размножении через Файл-Просмотр печати-Инструмент спуска макета. Макет на печать идет размером 17 метров и печать происходит быстро не нагружая компьютер.

Окно выбора настроек печати после выбора принтера и настройки параметров при нажатии на кнопку печать, закрывается и печать не происходит.

wOxxOm · 18.06.2007

Ответ: Подставить автоматически при открытии файла текушюю дату +18 месяцев.

Окно выбора настроек печати после выбора принтера и настройки параметров при нажатии на кнопку печать, закрывается и печать не происходит.

смотрим пост выше -
if ActiveDocument.PrintSettings.ShowDialog then ActiveDocument.PrintOut

А насчет размера...се ля ви, визард команду драйверу принтера множить дает! а тут исходник множится. Надо может пооптимизировать базовый объект

TheMarshal · 19.06.2007

Ответ: Подставить автоматически при открытии файла текушюю дату +18 месяцев.

wOxxOm сказал(а):
Надо может пооптимизировать базовый объект

Ниже не куда, файл 60 кб.

Можно записать в макросе, дать команду визарду множить?

wOxxOm · 19.06.2007

Ответ: Подставить автоматически при открытии файла текушюю дату +18 месяцев.

Это можно сделать через посылку клавиш, легче всего по-моему в AutoHotkey. Команда send. Примеров много в нете и в хелпе AutoHotKey.

Разумеется подойдет любой другой (более фейсовый) клавиатурный менеджер, в котором есть запись и проигрыш нажатий клавиш

lev · 19.06.2007

Ответ: Подставить автоматически при открытии файла текушюю дату +18 месяцев.

moderatorial
Просьба использовать для выделения кода теги [ code], а не [ php]. Лучше код без подсветки, чем с такой.

Поиск

Подставить автоматически при открытии файла текущюю дату +18 месяцев.

TheMarshal

Участник

Вложения

TheMarshal

Участник

Вложения

wOxxOm

Участник

dizzy

Участник

TheMarshal

Участник

TheMarshal

Участник

TheMarshal

Участник

dizzy

Участник

TheMarshal

Участник

wOxxOm

Участник

TheMarshal

Участник

wOxxOm

Участник

TheMarshal

Участник

wOxxOm

Участник

lev

Модератор