Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

25 Октябрь 2020, 04:51 *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

Войти
Новости: Вы можете задать вопрос по LibreOffice или Apache OpenOffice без регистрации, используя форму
 
   Начало   Помощь Поиск Войти Регистрация    задать вопрос  
Страниц: 1   Вниз
  Печать  
Автор Тема: Скопировать 2 листа из документа в новый документ без формул  (Прочитано 2483 раз)
0 Пользователей и 1 Гость смотрят эту тему.
Sintagma
Новичок
*
Offline Offline

Сообщений: 2


« Стартовое сообщение: 5 Март 2016, 17:26 »

Добрый день.

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

У меня есть макрос, который копирует один лист "Карточка сведений" в новый документ. Нужно как-то его модифицировать, либо написать новый, который мог бы копировать помимо "Карточки сведений" ещё и лист "Доп инфо".

Вот сам макрос:
-----------------------------
REM ***** BASIC *****

    Sub ExportKS
    Dim noProps()
    Dim InsertProps(5) as new com.sun.star.beans.PropertyValue
    InsertProps(0).Name = "Flags"
    InsertProps(0).Value = "SVDNT"
    InsertProps(1).Name = "FormulaCommand"
    InsertProps(1).Value = 0
    InsertProps(2).Name = "SkipEmptyCells"
    InsertProps(2).Value = false
    InsertProps(3).Name = "Transpose"
    InsertProps(3).Value = false
    InsertProps(4).Name = "AsLink"
    InsertProps(4).Value = false
    InsertProps(5).Name = "MoveMode"
    InsertProps(5).Value = 4

    firstDoc = ThisComponent
    selectSheetByName(firstDoc, "Карточка сведений")
    dispatchURL(firstDoc,".uno:SelectAll", noProps())
    dispatchURL(firstDoc,".uno:Copy", noProps())
    secondDoc = StarDesktop.loadComponentFromUrl("private:factory/scalc","_blank",0,dimArray())
    secondDoc.getSheets().insertNewByName("Карточка сведений",0)
    selectSheetByName(secondDoc, "Карточка сведений")
    dispatchURL(secondDoc,".uno:InsertContents", InsertProps())
    End Sub

    Sub selectSheetByName(document, sheetName)
    document.getCurrentController.select(document.getSheets().getByName(sheetName))
    End Sub

    Sub dispatchURL(document, aURL, Props)
    Dim URL as new com.sun.star.util.URL
    frame = document.getCurrentController().getFrame()
    URL.Complete = aURL
    transf = createUnoService("com.sun.star.util.URLTransformer")
    transf.parseStrict(URL)
    disp = frame.queryDispatch(URL, "", com.sun.star.frame.FrameSearchFlag.SELF OR com.sun.star.frame.FrameSearchFlag.CHILDREN)
    disp.dispatch(URL, Props())
    End Sub
---------------------------------------

Файл .xls во вложении. Помогите, пожалуйста )
Заранее благодарна!

* Пример.xls (8.5 Кб - загружено 15 раз.)
Записан
rami
Гуру
*******
Offline Offline

Пол: Мужской
Сообщений: 3 024


iMac, LibreOffice и Apache OpenOffice


« Ответ #1: 5 Март 2016, 18:09 »

У меня есть макрос, который копирует один лист "Карточка сведений" в новый документ. Нужно как-то его модифицировать, либо написать новый, который мог бы копировать помимо "Карточки сведений" ещё и лист "Доп инфо".
Второй лист копируется как и первый, только не нужно второй раз открывать новый документ

Код:
Sub ExportKS
Dim noProps()
Dim InsertProps(5) as new com.sun.star.beans.PropertyValue
InsertProps(0).Name = "Flags"
InsertProps(0).Value = "SVDNT"
InsertProps(1).Name = "FormulaCommand"
InsertProps(1).Value = 0
InsertProps(2).Name = "SkipEmptyCells"
InsertProps(2).Value = false
InsertProps(3).Name = "Transpose"
InsertProps(3).Value = false
InsertProps(4).Name = "AsLink"
InsertProps(4).Value = false
InsertProps(5).Name = "MoveMode"
InsertProps(5).Value = 4

firstDoc = ThisComponent
selectSheetByName(firstDoc, "Доп инфо")
dispatchURL(firstDoc,".uno:SelectAll", noProps())
dispatchURL(firstDoc,".uno:Copy", noProps())
secondDoc = StarDesktop.loadComponentFromUrl("private:factory/scalc","_blank",0,dimArray())
secondDoc.getSheets().insertNewByName("Доп инфо",0)
selectSheetByName(secondDoc, "Доп инфо")
dispatchURL(secondDoc,".uno:InsertContents", InsertProps())

selectSheetByName(firstDoc, "Карточка сведений")
dispatchURL(firstDoc,".uno:SelectAll", noProps())
dispatchURL(firstDoc,".uno:Copy", noProps())

secondDoc.getSheets().insertNewByName("Карточка сведений",0)
selectSheetByName(secondDoc, "Карточка сведений")
dispatchURL(secondDoc,".uno:InsertContents", InsertProps())
End Sub

Sub selectSheetByName(document, sheetName)
document.getCurrentController.select(document.getSheets().getByName(sheetName))
End Sub

Sub dispatchURL(document, aURL, Props)
Dim URL as new com.sun.star.util.URL
frame = document.getCurrentController().getFrame()
URL.Complete = aURL
transf = createUnoService("com.sun.star.util.URLTransformer")
transf.parseStrict(URL)
disp = frame.queryDispatch(URL, "", com.sun.star.frame.FrameSearchFlag.SELF OR com.sun.star.frame.FrameSearchFlag.CHILDREN)
disp.dispatch(URL, Props())
End Sub

P.S. такого использования диспетчера я ещё не видел
Записан

Sintagma
Новичок
*
Offline Offline

Сообщений: 2


« Ответ #2: 9 Март 2016, 10:34 »

rami, большое Вам спасибо! Вы меня очень выручили!  Улыбка
Записан
Страниц: 1   Вверх
  Печать  
 
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2009, Simple Machines Valid XHTML 1.0! Valid CSS!