Скопировать 2 листа из документа в новый документ без формул

Автор Sintagma, 5 марта 2016, 17:26

0 Пользователи и 1 гость просматривают эту тему.

Sintagma

Добрый день.

Необходим макрос, с помощью которого можно скопировать 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 во вложении. Помогите, пожалуйста )
Заранее благодарна!

rami

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

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

rami, большое Вам спасибо! Вы меня очень выручили!  :)