'макрос редактирования пдф файла расчета с добавлением имени файла
'  
'15/01/2018
'bigorq


StartFolderPath = "d:\1" ' задаем папку где осуществляется перебор pdf файлов

On Error Resume Next
Dim fso
Dim objFolder
Dim objFile
Dim objSubfolder
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = fso.GetFolder(StartFolderPath)
set oFiles = objFolder.Files

for each objFile in oFiles
   work2(objFile)
next
msgbox "Файлы обработаны"


sub work2 (files)
' подключаемся к LibreOffice
Dim oDrawPage, aURL
Dim Param(1),Param1(0)
Dim oPage 
Dim oShape 
Set ServiceManager = CreateObject("com.sun.star.ServiceManager")
Set Desktop = ServiceManager.createInstance("com.sun.star.frame.Desktop")
Set Param(1) = ServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
Set Param(0) = ServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
Set Param1(0) = ServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")

   Param(0).Name = "Hidden"      ' делаем все скрытно 
   Param(0).Value = true
   Param(1).Name = "FilterName"      ' импортируем пдф
   Param(1).Value = draw_pdf_import

Set Document1 = Desktop.LoadComponentFromURL("file:///"&dos2unix(files.path ,"\\" ,"/" ), "_blank", 0, Param)
   

set oDrawPage=Document1.DrawPages(0)

 
set Point = ServiceManager.Bridge_GetStruct("com.sun.star.awt.Point")
set Size = ServiceManager.Bridge_GetStruct("com.sun.star.awt.Size")
   Point.x = 16000    'начальная Х координата текстового бокса
   Point.y = 500      'начальная Y координата текстового бокса
   Size.Width = 4500   'ширина
   Size.Height = 100
 
set oPage = Document1.drawPages(0)

set oShape = Document1. createInstance("com.sun.star.drawing.TextShape")
    oPage.getByIndex(0).add(oShape)
   oShape. Position = Point
   oShape. Size = size
   oShape. setString(files.name) 'прописываем имя файла
   oShape. Shadow = false
   oShape.CharHeight=10
   oPage.getByIndex(0).add(oShape)

  Param1(0).Name =  "FilterName"
  Param1(0).Value = "draw_pdf_Export" 'экспортируем в ПДФ
 
 aURL = Document1.getLocation()
 Document1.storeToUrl aURL, Param1    'сохраняем
 Document1.close true            'закрываем
 
end sub




Function dos2unix(txt, expr1, expr2) ' функция конвертирования путей
    ' Замена строк
    Dim oReg

    Set oReg = New RegExp        ' Открываем регулярные выражения.
    oReg.Global = True           ' меняем все
    oReg.IgnoreCase = True       ' игнорируем регистр
    oReg.Pattern = expr1         ' что меняем.
    dos2unix = oReg.Replace(txt, expr2)
End Function