Макрос Microsoft Excel для работы в Libreoffice

[sokol92]

А что Вы хотите отпечатать - листы документа или какие-то области в них и в какой момент времени?

Вот еще тема печати на нашем форуме.

[Вячеслав22]

Желательно как в этом коде, сначала листы печатаются потом сохраняются, данные меняются и т.д.

Код Выделить Развернуть

Sub Адрес()
'
' Адрес
'
dosyaadi1 = Cells(1, 3)
donbasa:
Set klasor = CreateObject("shell.application").Browseforfolder(0, "Выберите место для сохранения заключений", 100, &H0)

If klasor Is Nothing Then GoTo donbasa
kaynak = klasor.self.Path
Cells(1, 3) = kaynak
kayityeri = Cells(1, 3)

End Sub


Sub Печать()

'
' Печать
'

reportno = Cells(8, 3)
dosyayolu = Cells(1, 3)
AA = Cells(6, 3)
BB = Cells(6, 4)
If AA > BB Then
    Cells(6, 3) = AA
    BB = Cells(6, 3)
Else
End If
If dosyayolu = "" Then
    MsgBox "Lutfen Klasor Secimini Yapiniz !", vbInformation, "Uyari"
    Call Адрес
    dosyayolu = Cells(1, 3)
Else
End If
Application.ScreenUpdating = False
For jts = AA To BB Step 1
    Cells(6, 3) = jts
    Sheets("Данные").Calculate
    reportno = Cells(5, 9)

    ChDir dosyayolu

    Sheets("ВИК-РД").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
        Sheets("РК-РД").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
        Sheets("КАП-РД").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
        Sheets("ВИК-РАД").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
        Sheets("РК-РАД").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
        Sheets("КАП-РАД").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
       
        Worksheets(Array("ВИК-РД", "РК-РД", "КАП-РД")).Select
        Клеймо = Sheets("ВИК-РД").Cells(2, 12)
        имяфайла = Клеймо & " Заключение-РД"
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        имяфайла, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

        Worksheets(Array("ВИК-РАД", "РК-РАД", "КАП-РАД")).Select
        Клеймо = Sheets("ВИК-РАД").Cells(2, 12)
        имяфайла = Клеймо & " Заключение-РАД"
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        имяфайла, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
         Sheets("Данные").Select
       
Next jts
Application.ScreenUpdating = True

End Sub

[Вячеслав22]

Если получится в этот код добавить печать листов, потом их сохранение

[bigor]

  когда еще в #5 я переводил код на starbasic то закомментировал печать, что бы не мешала отладке. Если в вашем файле из #32 раскомментировать  строки  ThisComponent.print(Props()), то все должно печататься

[Вячеслав22]

когда еще в #5 я переводил код на starbasic то закомментировал печать, что бы не мешала отладке. Если в вашем файле из #32 раскомментировать  строки  ThisComponent.print(Props()), то все должно печататься

Я брал Ваш файл #7 и он тоже только сохраняет листы

[bigor]

Ну так я потестил, что печать работает и закомментировал строки, что бы не мешало остальное делать. И все остальные варианты были с отключенной печатью, я и забыл про нее, пока сейчас не глянул ваш файл.

[Вячеслав22]

Ну так я потестил, что печать работает и закомментировал строки, что бы не мешало остальное делать. И все остальные варианты были с отключенной печатью, я и забыл про нее, пока сейчас не глянул ваш файл.

А как их раскомментировать, чтобы печать работала?

[bigor]

А как их раскомментировать

удалите перед ними апостроф.

[Вячеслав22]

А как их раскомментировать

удалите перед ними апостроф.

Благодарю! Разобрался, всё работает.
Вы разработчик LibreOffice или оказываете поддержку?

[bigor]

Вы разработчик LibreOffice или оказываете поддержку?

не, я просто им пользуюсь и помогаю другим

[Вячеслав22]

Вы разработчик LibreOffice или оказываете поддержку?

не, я просто им пользуюсь и помогаю другим

Добрый день! Подскажите почему печатает по две копии? Сначала печатает в одном экземпляре, потом начинает печатать по две копии как исправить?

Код Выделить Развернуть

Sub Main()
'
' Адрес
'
dosyaadi1 = ThisComponent.sheets.GetbyName("Данные").getCellByPosition(3, 0).getString

kaynak=getFolder("Выберите место для сохранения заключений")&"/"
ThisComponent.sheets.GetbyName("Данные").getCellByPosition(3, 0).setString(kaynak)
kayityeri = kaynak

End Sub


Sub Main1()

'
' Печать
'
Dim Props(0 To 1) As New com.sun.star.beans.PropertyValue
Dim aSel(0) as new com.sun.star.beans.PropertyValue
Dim aSel1(0) as new com.sun.star.beans.PropertyValue
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

reportno = ThisComponent.sheets.GetbyName("Данные").getCellByPosition(2, 7).getString
dosyayolu = ThisComponent.sheets.GetbyName("Данные").getCellByPosition(3, 0).getString
AA = ThisComponent.sheets.GetbyName("Данные").getCellByPosition(3, 5).getValue
BB = ThisComponent.sheets.GetbyName("Данные").getCellByPosition(4, 5).getValue
If AA > BB Then
    BB = AA
 Else
End If
If dosyayolu = "" Then
    MsgBox "Выберите место для сохранения заключений", vbInformation, "Предупреждение"
    Call Main
    dosyayolu = ThisComponent.sheets.GetbyName("Данные").getCellByPosition(3, 0).getString
Else
End If
'Application.ScreenUpdating = False
For jts = AA To BB Step 1
    ThisComponent.sheets.GetbyName("Данные").getCellByPosition(3, 5).setValue(jts)
    'Sheets("Данные").Calculate
    reportno = ThisComponent.sheets.GetbyName("Данные").getCellByPosition(7, 4).getValue
   
        Props(0).Name = "Wait"
        Props(0).Value = true
        Props(1).Name = "CopyCount"
        Props(1).Value = 1
    ThisComponent.CurrentController.setActiveSheet(ThisComponent.sheets.GetbyName("ВИК-РД"))
    ThisComponent.print(Props())
        Props(0).Name = "Wait"
        Props(0).Value = true
        Props(1).Name = "CopyCount"
        Props(1).Value = 1
    ThisComponent.CurrentController.setActiveSheet(ThisComponent.sheets.GetbyName("РК-РД"))
    ThisComponent.print(Props())
 
Props(0).Name = "FilterName"
Props(0).Value = "calc_pdf_Export"
' Props(1).Name = "FilterName"
' Props(1).Value = "calc_pdf_Export"
 
    aSel(0).Name="Tables"
    aSel(0).Value=Array(ThisComponent.Sheets.getByName("ВИК-РД").RangeAddress.Sheet, ThisComponent.Sheets.getByName("РК-РД").RangeAddress.Sheet)      ' индексы листов для печати (нумерация от 0)
    dispatcher.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:SelectTables", "", 0, aSel)
   
     aSel1(0).Name="Selection"
     aSel1(0).Value=ThisComponent.CurrentSelection
    Props(0).Name = "FilterName"
    Props(0).Value = "calc_pdf_Export"   
    Props(1).Name = "FilterData"
    Props(1).Value = aSel1   

           
   conclusion = ThisComponent.sheets.GetbyName("ВИК-РД").getCellByPosition(38, 2).getString
   FCs = ThisComponent.sheets.GetbyName("ВИК-РД").getCellByPosition(31, 5).getString
   AVR = ThisComponent.sheets.GetbyName("ВИК-РД").getCellByPosition(31, 4).getString
   nameconclusion = conclusion & " " & FCs & " АТТ АВР №" & AVR
   '     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
   '     nameconclusion, Quality:=xlQualityStandard, _
   '     IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
   '      Sheets("Данные").Select
         ThisComponent.storeToURL( dosyayolu & nameconclusion & ".pdf",Props())
       
Next jts
'Application.ScreenUpdating = True
ThisComponent.CurrentController.setActiveSheet(ThisComponent.sheets.GetbyName("Данные"))
End Sub

Sub Main2()

'
' Печать
'
Dim Props(0 To 1) As New com.sun.star.beans.PropertyValue
Dim aSel(0) as new com.sun.star.beans.PropertyValue
Dim aSel1(0) as new com.sun.star.beans.PropertyValue
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

reportno = ThisComponent.sheets.GetbyName("Данные").getCellByPosition(2, 31).getString
dosyayolu = ThisComponent.sheets.GetbyName("Данные").getCellByPosition(3, 0).getString
AA = ThisComponent.sheets.GetbyName("Данные").getCellByPosition(3, 29).getValue
BB = ThisComponent.sheets.GetbyName("Данные").getCellByPosition(4, 29).getValue
If AA > BB Then
    BB = AA
 Else
End If
If dosyayolu = "" Then
    MsgBox "Выберите место для сохранения заключений", vbInformation, "Предупреждение"
    Call Main
    dosyayolu = ThisComponent.sheets.GetbyName("Данные").getCellByPosition(3, 0).getString
Else
End If
'Application.ScreenUpdating = False
For jts = AA To BB Step 1
    ThisComponent.sheets.GetbyName("Данные").getCellByPosition(3, 29).setValue(jts)
    'Sheets("Данные").Calculate
    reportno = ThisComponent.sheets.GetbyName("Данные").getCellByPosition(7, 4).getValue
   
        Props(0).Name = "Wait"
        Props(0).Value = true
        Props(1).Name = "CopyCount"
        Props(1).Value = 1
    ThisComponent.CurrentController.setActiveSheet(ThisComponent.sheets.GetbyName("ВИК-РАД"))
    ThisComponent.print(Props())
        Props(0).Name = "Wait"
        Props(0).Value = true
        Props(1).Name = "CopyCount"
        Props(1).Value = 1
    ThisComponent.CurrentController.setActiveSheet(ThisComponent.sheets.GetbyName("РК-РАД"))
    ThisComponent.print(Props())
 
Props(0).Name = "FilterName"
Props(0).Value = "calc_pdf_Export"
' Props(1).Name = "FilterName"
' Props(1).Value = "calc_pdf_Export"
 
    aSel(0).Name="Tables"
    aSel(0).Value=Array(ThisComponent.Sheets.getByName("ВИК-РАД").RangeAddress.Sheet, ThisComponent.Sheets.getByName("РК-РАД").RangeAddress.Sheet)      ' индексы листов для печати (нумерация от 0)
    dispatcher.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:SelectTables", "", 0, aSel)
   
     aSel1(0).Name="Selection"
     aSel1(0).Value=ThisComponent.CurrentSelection
    Props(0).Name = "FilterName"
    Props(0).Value = "calc_pdf_Export"   
    Props(1).Name = "FilterData"
    Props(1).Value = aSel1

           
   conclusion = ThisComponent.sheets.GetbyName("ВИК-РАД").getCellByPosition(38, 2).getString
   FCs = ThisComponent.sheets.GetbyName("ВИК-РАД").getCellByPosition(31, 5).getString
   AVR = ThisComponent.sheets.GetbyName("ВИК-РАД").getCellByPosition(31, 4).getString
   nameconclusion = conclusion & " " & FCs & " АТТ АВР №" & AVR
   '     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
   '     nameconclusion, Quality:=xlQualityStandard, _
   '     IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
   '      Sheets("Данные").Select
         ThisComponent.storeToURL( dosyayolu & nameconclusion & ".pdf",Props())
       
Next jts
'Application.ScreenUpdating = True
ThisComponent.CurrentController.setActiveSheet(ThisComponent.sheets.GetbyName("Данные"))
End Sub


Function getFolder(sTitle AS String, optional sInitDir) AS String
   oPicker = CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")
   oPicker.setTitle(sTitle)
   if not ismissing(sInitDir) then oPicker.setDisplayDirectory(sInitDir)
   if oPicker.execute() then getFolder = oPicker.getDirectory()
   'msgbox getFolder
End Function

[bigor]

Без файла трудно, что то сказать. Но макрос печатает по одной копии, вопрос только сколько раз. Это зависит от переменных АА и ВВ

[Вячеслав22]

Файл

[Вячеслав22]

Без файла трудно, что то сказать. Но макрос печатает по одной копии, вопрос только сколько раз. Это зависит от переменных АА и ВВ

Переменные ставлю от 1 до 11 (например)

[bigor]

Так если от 1 до 11, то у вас ThisComponent.print(Props()) запускается в цикле на каждм шаге.