[CDR 2017-2021] Вставка имени файла в документ

[MrDesigner]

Здравствуйте!
Сложно ли написать макрос вставки имени файла в открытом кореловском документе?

Выделяем объект (на скриншоте - голубой прямоугольник), нажимаем кнопку, в правом нижнем углу, допустим (для понимания отступы от краёв выделенного объекта обозначены, они не меняются), появляется имя файла (ИмяФайлаТут, Color - K30%, Size - 24 pt, Alignment - Right, Font - пусть будет Arial normal).

Задача - подписывать баннеры.

Благодарю!

 

[Karatau]

Есть уже готовый макрос с данной функцией - grommets

Ну а в принципе совсем не сложно получить в макросе имя файла

dim name$
name = ActiveDocument.FileName

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

 

[_MBK_]

Это если файл хоть раз сохранялся, разумеется

 

[Как_же_так]

File Name Inserter в 2017-м работает, попробуйте

 

[dastin]

File Name Inserter в 2017-м работает, попробуйте

сюда ещё просится пунктик Active Page only
и выбор цвета надписи ТС просит ...

 

[MrDesigner]

File Name Inserter в 2017-м работает, попробуйте

Всё хорошо, только этот макрос выводит имя файла в пределах Page Size. Мне же нужно, чтобы он выводил его относительно выделенного объекта...

 

[MrDesigner]

Хм. Нашёл нечто похожее в сети. Макрос:

Sub InsertFileName()
   If ActiveShape Is Nothing Then Beep: Exit Sub
   ActiveLayer.CreateArtisticText _
      ActiveShape.RightX, _
      ActiveShape.BottomY - ActiveDocument.ToUnits(10, cdrMillimeter), _
      ActiveDocument.FullFileName, , , _
      "Tahoma", 24, Alignment:=cdrRightAlignment
End Sub

Работает. При выделенном объекте имя файла располагается внизу справа.

А теперь, с вашего позволения, непосредственные вопросы:

1. Как сделать отступ текста справа и сверху от выделенного объекта?

2. Можно сделать так, чтобы имя файла писалось без полного пути?

3. Цвет шрифта как поменять?

 

[_MBK_]

1. Как сделать отступ текста справа и сверху от выделенного объекта?

ActiveLayer.CreateArtisticText _
      ActiveShape.RightX, _
      ActiveShape.TopY + ActiveDocument.ToUnits(10, cdrMillimeter), _
      ActiveDocument.FullFileName, , , _
      "Tahoma", 24, Alignment:=cdrRightAlignment

 

[_MBK_]

3. Цвет шрифта как поменять?

Set txt=ActiveLayer.CreateArtisticText (_
      ActiveShape.RightX, _
      ActiveShape.BottomY - ActiveDocument.ToUnits(10, cdrMillimeter), _
      ActiveDocument.FullFileName, , , _
      "Tahoma", 24, Alignment:=cdrRightAlignment)
txt.Fill.UniformColor = CreateCMYKColor(0, 0, 100, 0)

 

[_MBK_]

2. Можно сделать так, чтобы имя файла писалось без полного пути?

ActiveDocument.Name

 

[MrDesigner]

@_MBK_, неправильно выразился.

Сейчас макрос ставит имя так:

Нужно так:

Т.е. сдвинуть влево на 150 мм и поднять вверх на 15 мм.

Спасиб!

 

[_MBK_]

Тогда то же самое как было но вместо DX DY нужные смещения

ActiveLayer.CreateArtisticText _
      ActiveShape.RightX-ActiveDocument.ToUnits(DX, cdrMillimeter), _
      ActiveShape.BottomY +ActiveDocument.ToUnits(DY, cdrMillimeter), _
      ActiveDocument.FullFileName, , , _
      "Tahoma", 24, Alignment:=cdrRightAlignment

 

[MrDesigner]

Set txt=ActiveLayer.CreateArtisticText (_
      ActiveShape.RightX, _
      ActiveShape.BottomY - ActiveDocument.ToUnits(10, cdrMillimeter), _
      ActiveDocument.FullFileName, , , _
      "Tahoma", 24, Alignment:=cdrRightAlignment)
txt.Fill.UniformColor = CreateCMYKColor(0, 0, 100, 0)

Ошибку пишет.

Сейчас рабочий код такой:

Sub InsertFileName()
   If ActiveShape Is Nothing Then Beep: Exit Sub
   ActiveLayer.CreateArtisticText _
      ActiveShape.RightX, _
      ActiveShape.BottomY - ActiveDocument.ToUnits(10, cdrMillimeter), _
      ActiveDocument.Name, , , _
      "Tahoma", 24, Alignment:=cdrRightAlignment
End Sub

 

[MrDesigner]

Итого. Работает, как нужно.

Sub InsertFileName()
   If ActiveShape Is Nothing Then Beep: Exit Sub
   ActiveLayer.CreateArtisticText _
      ActiveShape.RightX - ActiveDocument.ToUnits(150, cdrMillimeter), _
      ActiveShape.BottomY + ActiveDocument.ToUnits(15, cdrMillimeter), _
      ActiveDocument.Name, , , _
      "Tahoma", 24, Alignment:=cdrRightAlignment
End Sub

С цветом шрифта что-то ошибку даёт. Как правильно?

 

[_MBK_]

Ошибку пишет.

Какую?
Еще так попробуй

Sub InsertFileName()
   If ActiveShape Is Nothing Then Beep: Exit Sub
   set txt=ActiveLayer.CreateArtisticText _
      ActiveShape.RightX - ActiveDocument.ToUnits(150, cdrMillimeter), _
      ActiveShape.BottomY + ActiveDocument.ToUnits(15, cdrMillimeter), _
      ActiveDocument.Name, , , _
      "Tahoma", 24, Alignment:=cdrRightAlignment
   txt.Fill.ApplyUniformFill CreateRGBColor(255, 0, 0)
End Sub

 

[MrDesigner]

Какую?

 

[_MBK_]

Ну сделай без переносов в одну строку

Sub InsertFileName()
   If ActiveShape Is Nothing Then Beep: Exit Sub
   Set txt = ActiveLayer.CreateArtisticText(ActiveShape.RightX - ActiveDocument.ToUnits(150, cdrMillimeter), ActiveShape.BottomY, ActiveDocument.ToUnits(15, cdrMillimeter), ActiveDocument.Name, , , "Tahoma", 24, Alignment:=cdrRightAlignment)
   txt.Fill.ApplyUniformFill CreateRGBColor(255, 0, 0)
End Sub

 

[MrDesigner]

Вот такая конструкция работает:

Sub InsertFileName()
   If ActiveShape Is Nothing Then Beep: Exit Sub
   ActiveLayer.CreateArtisticText _
      ActiveShape.RightX - ActiveDocument.ToUnits(150, cdrMillimeter), _
      ActiveShape.BottomY + ActiveDocument.ToUnits(15, cdrMillimeter), _
      ActiveDocument.Name, , , _
      "Tahoma", 24, Alignment:=cdrRightAlignment
      ActiveShape.Fill.UniformColor.CMYKAssign 0, 0, 0, 30
End Sub

Она верна? Никакие другие объекты в макете перекрашены не будут?

 

[_MBK_]

Она верна? Никаких других объектов в макете исправлено не будет?

Это несколько заднепроходно
Смотри в чем дело - тебе надо установить цвет созданному объекту
А у тебя устанавливается активному шейпу. По счастливому стечению обстоятельств новосозданный объект становится активным но это сильно по индусски
С другой стороны работает и ладно

 

[dastin]

так получилось ... у Михаила лаконичней

Sub InsertFileName()
    Set s = ActiveShape
   If s Is Nothing Then Beep: Exit Sub
    Set txt = ActiveLayer.CreateArtisticText_
    (s.RightX - ActiveDocument.ToUnits(10, cdrMillimeter), _
    s.BottomY - ActiveDocument.ToUnits(40, cdrMillimeter),  _
    ActiveDocument.FileName, , , "Tahoma", 24, Alignment:=cdrRightAlignment)
    txt.Fill.UniformColor = CreateCMYKColor(0, 0, 0, 30)    '  так тоже можно  txt.Fill.UniformColor.CMYKAssign 0, 0, 0, 30
End Sub

ActiveShape.Fill.UniformColor.CMYKAssign 0, 0, 0, 30

выделенный объект зачем перекрашивать?