Закрыть другой документ макросом.

[sna4e]

Доброго времени суток.
Есть несколько открытых документов, старый файл и новый. Макрос запускается в новом, из старого два столбца переносятся в новый. Хочу чтобы этот же макрос закрывал старый документ и переносил его в другую папку. Как переносить в другую папку я понимаю, но не могу понять как его закрыть. Как к нему обратиться?
Подскажите, пожалуйста.

[rami]

Допустим, что документ который нужно закрыть обозначен oDoc, тогда

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

oDoc.close(true)закроет этот документ.

[sna4e]

Допустим, что документ который нужно закрыть обозначен oDoc, тогда

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

oDoc.close(true)закроет этот документ.

Да, это понимаю. Но у меня
oDoc = ThisComponent
То есть тот, в котором запущен макрос. А как выбрать другой документ, открытый на ПК?
Собственно вопрос именно в том чему равно оDoc?

[rami]

Есть несколько открытых документов, старый файл и новый. Макрос запускается в новом, из старого два столбца переносятся в новый. Хочу чтобы этот же макрос закрывал старый документ и переносил его в другую папку. Как переносить в другую папку я понимаю, но не могу понять как его закрыть. Как к нему обратиться?

Из вашего вопроса я понял, что у вас есть макрос, который переносит два столбца из одного документа в другой, для этого у вас должны быть переменные обоих документов.

А как выбрать другой документ, открытый на ПК?

Для этого нужно перебрать фреймы на рабочем столе и выбрать нужный, но перебор фреймов должен быть до переноса столбцов, а не после (или вы переносите столбцы воздушно-капельным путём )

Покажите ваш макрос.

Для переноса (импорта) данных из одного документа в другой, совсем не обязательно открывать документ с исходными данными.

[kompilainenn]

Для переноса (импорта) данных из одного документа в другой, совсем не обязательно открывать документ с исходными данными.

это как? как он его читает, не открывая? фигсе, до чего техника дошла...

[sna4e]

Есть несколько открытых документов, старый файл и новый. Макрос запускается в новом, из старого два столбца переносятся в новый. Хочу чтобы этот же макрос закрывал старый документ и переносил его в другую папку. Как переносить в другую папку я понимаю, но не могу понять как его закрыть. Как к нему обратиться?

Из вашего вопроса я понял, что у вас есть макрос, который переносит два столбца из одного документа в другой, для этого у вас должны быть переменные обоих документов.

А как выбрать другой документ, открытый на ПК?

Для этого нужно перебрать фреймы на рабочем столе и выбрать нужный, но перебор фреймов должен быть до переноса столбцов, а не после (или вы переносите столбцы воздушно-капельным путём )

Покажите ваш макрос.

Для переноса (импорта) данных из одного документа в другой, совсем не обязательно открывать документ с исходными данными.

Это я неверно выразился:(
Макрос только вставляет столбцы, копирую я их ручками.
Вот немного устаревший вариант, но он отлично показывает, насколько низки мои знания.

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

sub Main
rem объ¤вление переменных
Dim Doc As Object
Dim Sheet As Object
Dim Col As Object
Static kolvo_strok As Integer
DIM imya As string
dim dispatcher as object
Dim Doc1 As Object
Dim start As Date
Dim finish As Date
Dim res As Date
start = now
Doc = ThisComponent
Sheet = Doc.getSheets.getByIndex(0)
Doc1   = ThisComponent.CurrentController.Frame
rem ----------------------------------------------------------------------
rem —ледующие строки вставл¤ют столбцы K и L
MsgBox(" оллега, убедись, что скопировал столбцы E и J из предыдущей выгрузки",0)
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$K$1"

dispatcher.executeDispatch(Doc1, ".uno:GoToCell", "", 0, args1())
dispatcher.executeDispatch(Doc1, ".uno:Paste", "", 0, Array())
rem ----------------------------------------------------------------------

rem далее установка ширины столбцов --------------------------
Col = Sheet.Columns(0) rem столбец A
col.Width = 5240
Col = Sheet.Columns(1) rem столбец B
col.Width = 8800
Col = Sheet.Columns(2) rem столбец C
col.Width = 2660
Col = Sheet.Columns(3) rem столбец D
col.Width = 920
Col = Sheet.Columns(4) rem столбец E
col.Width = 2000
Col = Sheet.Columns(5) rem столбец F
col.Width = 800
Col = Sheet.Columns(6) rem столбец G
col.Width = 2200
Col = Sheet.Columns(7) rem столбец H
col.Width = 2200
Col = Sheet.Columns(8) rem столбец I
col.Width = 1750
rem -------------------------------------------------------------

rem ---------------------------------------------------------------
rem считаем количество строк в документе
kolvo_strok=1
Cell = Sheet.getCellByPosition(4,kolvo_strok)
Do  Until Cell.Type = com.sun.star.table.CellContentType.EMPTY
kolvo_strok = kolvo_strok+500
Cell = Sheet.getCellByPosition(4,kolvo_strok)
Loop
Do While Cell.Type = com.sun.star.table.CellContentType.EMPTY
kolvo_strok = kolvo_strok-1
Cell = Sheet.getCellByPosition(4,kolvo_strok)
Loop
kolvo_strok=kolvo_strok+1
rem -------------------------------------------------------------
rem вставл¤ем ¬ѕ– в таблицу
Cell = Sheet.getCellByPosition(9,1)
Cell.Formula = "=VLOOKUP(E2;$K$2:$L$"+kolvo_strok+";2;0)"
dim args01(0) as new com.sun.star.beans.PropertyValue
args01(0).Name = "ToPoint"
args01(0).Value = "$J$2"
dispatcher.executeDispatch(Doc1, ".uno:GoToCell", "", 0, args01())
dispatcher.executeDispatch(Doc1, ".uno:Copy", "", 0, Array()
dim args02(0) as new com.sun.star.beans.PropertyValue
args02(0).Name = "ToPoint"
args02(0).Value = "$J$3:$J$"+kolvo_strok
dispatcher.executeDispatch(Doc1, ".uno:GoToCell", "", 0, args02())
dispatcher.executeDispatch(Doc1, ".uno:Paste", "", 0, Array()
'-------------------------------------------------------------------
rem далее вставка ¤чеек в J в виде текста
dim args2(0) as new com.sun.star.beans.PropertyValue
args2(0).Name = "ToPoint"
args2(0).Value = "$J$1:$J$"+kolvo_strok
dispatcher.executeDispatch(Doc1, ".uno:GoToCell", "", 0, args2())
dispatcher.executeDispatch(Doc1, ".uno:Copy", "", 0, Array())
dim args3(5) as new com.sun.star.beans.PropertyValue
args3(0).Name = "Flags"
args3(0).Value = "S"
args3(1).Name = "FormulaCommand"
args3(1).Value = 0
args3(2).Name = "SkipEmptyCells"
args3(2).Value = false
args3(3).Name = "Transpose"
args3(3).Value = false
args3(4).Name = "AsLink"
args3(4).Value = false
args3(5).Name = "MoveMode"
args3(5).Value = 4
dispatcher.executeDispatch(Doc1, ".uno:InsertContents", "", 0, args3())
rem -------------------------------------------------------------------

rem удаление столбцов K и L
dim args4(0) as new com.sun.star.beans.PropertyValue
args4(0).Name = "ToPoint"
args4(0).Value = "$K$1:$L$"+kolvo_strok
dispatcher.executeDispatch(Doc1, ".uno:GoToCell", "", 0, args4())
dim args5(0) as new com.sun.star.beans.PropertyValue
args5(0).Name = "Flags"
args5(0).Value = "A"
dispatcher.executeDispatch(Doc1, ".uno:Delete", "", 0, args5())
rem -------------------------------------------------------------------
Col = Sheet.Columns(9) rem столбец J установка оптимальной длины.
col.OptimalWidth = True
rem -------------------------------------------------------------------

rem выравнивание столбца C
dim args6(0) as new com.sun.star.beans.PropertyValue
args6(0).Name = "ToPoint"
args6(0).Value = "$C$2:$C$"+kolvo_strok
dispatcher.executeDispatch(Doc1, ".uno:GoToCell", "", 0, args6())
dim args7(0) as new com.sun.star.beans.PropertyValue
args7(0).Name = "HorizontalJustification"
args7(0).Value = com.sun.star.table.CellHoriJustify.CENTER
dispatcher.executeDispatch(Doc1, ".uno:HorizontalJustification", "", 0, args7())
rem ----------------------------------------------------------------------

rem выравнивание столбца E
dim args8(0) as new com.sun.star.beans.PropertyValue
args8(0).Name = "ToPoint"
args8(0).Value = "$E$2:$E$"+kolvo_strok
dispatcher.executeDispatch(Doc1, ".uno:GoToCell", "", 0, args8())
dim args9(0) as new com.sun.star.beans.PropertyValue
args9(0).Name = "HorizontalJustification"
args9(0).Value = com.sun.star.table.CellHoriJustify.CENTER
dispatcher.executeDispatch(Doc1, ".uno:HorizontalJustification", "", 0, args9())
rem ----------------------------------------------------------------------

rem выравнивание столбца H
dim args10(0) as new com.sun.star.beans.PropertyValue
args10(0).Name = "ToPoint"
args10(0).Value = "$H$2:$H$"+kolvo_strok
dispatcher.executeDispatch(Doc1, ".uno:GoToCell", "", 0, args10())
dim args11(0) as new com.sun.star.beans.PropertyValue
args11(0).Name = "HorizontalJustification"
args11(0).Value = com.sun.star.table.CellHoriJustify.CENTER
dispatcher.executeDispatch(Doc1, ".uno:HorizontalJustification", "", 0, args11())

rem ----------------------------------------------------------------------
rem схранение файла
IF Day(date)<10 Then
imya = "0"+CStr(Day(date))+"."+CStr(Month(date))+"."+Right(CStr(Year(date)), 2)
Else
imya = CStr(Day(date))+"."+CStr(Month(date))+"."+Right(CStr(Year(date)), 2)
End If
dim args12(1) as new com.sun.star.beans.PropertyValue
args12(0).Name = "URL"
args12(0).Value = "file:///C:/Users/%D0%9A%D1%80%D0%B8%D1%81%D1%82%D0%B8%D0%BD%D0%B0/Desktop/"+imya+".xls"
args12(1).Name = "FilterName"
args12(1).Value = "MS Excel 97"
dispatcher.executeDispatch(Doc1, ".uno:SaveAs", "", 0, args12())
finish = now
res = finish - start
MsgBox("«атраченное врем¤: "+res+";  количество строк в документе: "+kolvo_strok,0)
end sub
Самый актуальный вариант остался на работе. В нем я отказался от ВПРа, и переделал счет количества строк.

[sna4e]

Вопрос всё тот же: как переключаться между фреймами?

[rami]

Это я неверно выразился:(
Макрос только вставляет столбцы, копирую я их ручками.

А, понял, мы с макросом обрабатываем документ: макрос издаёт звук "бип", а я выполняю всю остальную работу.

Вот макрос, который закроет все документы кроме текущего, но я не вижу смысла в этом:

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

Sub main
sDoc=ThisComponent.Title
n=StarDesktop.Frames.Count
For i=0 To n-1
s=StarDesktop.Frames(i)
If s.Title<>sDoc And right(s.Title,8)<>"Standard" Then s.Close(True)
Next
End Sub

[rami]

это как? как он его читает, не открывая? фигсе, до чего техника дошла...

Дружище kompilainenn, ты прекращай баловаться с Машиной Времени, застрянешь в Прошлом и тебя никто не спасёт

GUI — графический интерфейс пользователя (т.е. вывод данных на экран) нужен исключительно для человека, для компа он не нужен. Начиная с самых первых электронных машин чтение, запись и обработка данных всегда были без вывода на экран.

На форуме раньше обсуждали подобные темы.

[JohnSUN]

sna4e, жаль, что не показал рабочий вариант... По тому коду, что выложил, есть несколько вопросов... Начнем, пожалуй, с организационных:
У Кристины на рабочем столе обязательно должен лежать рабочий файл? Нельзя ли затолкать сам файл в какую-нибудь папку-накопитель (например, D:\Vygruzki), а на рабочем столе оставить только ярлык? Ярлык всегда с одним и тем же именем, но ссылающийся всегда на самый свежий файл?..
В приведенном коде нет (во всяком случае, я его не увидел) фрагмента, который занимается переносом в другую папку. Вообще-то, ты писал, что

Как переносить в другую папку я понимаю...

но после прочтения скрипта "меня терзают смутные сомнения" (с) "С лёгким паром"

Теперь несколько технических замечаний.
Если в имени файла присутствует дата, то обычно её записывают задом наперёд - год-месяц-день. В этом случае при сортировке файлов в папке "по имени" они автоматически сортируются и "по дате создания". Кроме того, такое имя освобождает тебя от необходимости проверять сколько цифр в сегодняшнем числе. Мелочь, конечно, но все-таки на четыре строки кода меньше... (Тебе же, надеюсь, не за количество символов платят, нет?) Опять же, имя файла из одной только даты, без префиксов-суффиксов, ограничивает твою свободу - в следующий раз придётся изобретать какой-то другой способ именования... Написал бы что-то вроде

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

imya = convertToURL("D:\Vygruzki\Kristi"+Format(Date,"YYYY.MM.DD")+".xls")
Поиск последней заполненной строки у тебя выглядит... э-э-э... не убедительно. Это делается немного иначе... Загляни в стандартную библиотеку Tools, модуль Misc, найди там функцию GetLastUsedRow. Можешь просто скопировать её к себе в скрипт. Только не забудь изменить тип функции на Long. Так, на всякий случай.
Из этой же библиотеки Tools можешь утащить и функцию OpenDocument. Она сначала делает то, о чем написал rami - перебирает все открытые документы ("роется в памяти") и если не находит нужный - открывает его с диска...

...актуальный вариант остался на работе. В нем я отказался от ВПРа, и переделал счет количества строк.

Полностью одобряю отказ от VLOOKUP'а и последующей замены формул на вычисленные значения. Метод getDataArray почти мгновенно считает значения из нужного диапазона ячеек в массив. Перебрать элементы массива в двух вложенных циклах - доли секунды... И обратный метод setDataArray тоже работает очень быстро... Не удивляйся, если при такой организации работы твой последний MsgBox всегда будет сообщать Затраченное врем¤: 0;
А ещё можно сэкономить кучу времени и кода, если отказаться от полного форматирования документа макросом. Просто создай шаблон, в котором колонки A-J будут иметь правильную ширину и выравнивание, и именно его открывай для создания очередного файла.

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

[sna4e]

Sub main
sDoc=ThisComponent.Title
n=StarDesktop.Frames.Count
For i=0 To n-1
s=StarDesktop.Frames(i)
If s.Title<>sDoc And right(s.Title,8)<>"Standard" Then s.Close(True)
Next
End Sub

Этот макрос срабатывает как-то не так. Он закрывает все окна, пока не останется одно, но не то из которого запускал макрос, а то, что было открыто последним

[JohnSUN]

Это нюанс, связанный с разными мелочами в операционных системах. rami пример макроса набросал скорее всего под MacBook Pro 2015,  OS X 10.11.2, LibreOffice 5.0.4.2 (64бит) (видишь, у него в подписи?). Тебе нужно "подстроить" условие в If-Then под свои параметры.

Например, попробуй убрать эту часть проверки

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

And right(s.Title,8)<>"Standard"

[rami]

Это нюанс, связанный с разными мелочами...

Например, попробуй убрать эту часть проверки
Код:
And right(s.Title,8)<>"Standard"

Если макрос запускается из редактора, то эту часть убирать не надо, она предотвращает закрытие самого редактора в момент выполнения макроса. Если макрос запускается кнопкой, то эта часть не нужна.

Но вообще, мне не нравятся эти костыли

[sna4e]

Это нюанс, связанный с разными мелочами в операционных системах. rami пример макроса набросал скорее всего под MacBook Pro 2015,  OS X 10.11.2, LibreOffice 5.0.4.2 (64бит) (видишь, у него в подписи?). Тебе нужно "подстроить" условие в If-Then под свои параметры.

Например, попробуй убрать эту часть проверки

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

And right(s.Title,8)<>"Standard"

Ага, уже разобрался к моменту прочтения. Удивился правда: ситуация была в том, что на win7 у меня s.Title кроме названия файлика захватывает еще и " - OpenOffice Calc"
Соответственно код, закрывающий старый файл будет выглядеть так:

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

Sub main
n=StarDesktop.Frames.Count
For i=0 To n-1
s=StarDesktop.Frames(i)
IF s.Title ="пробник.ods - OpenOffice Calc" Then'
s.Close(True)
Exit For
END IF
Next
End Sub

Теперь о Вашем первом посте в этой теме.

У Кристины на рабочем столе обязательно должен лежать рабочий файл? Нельзя ли затолкать сам файл в какую-нибудь папку-накопитель (например, D:\Vygruzki), а на рабочем столе оставить только ярлык? Ярлык всегда с одним и тем же именем, но ссылающийся всегда на самый свежий файл?..

Это мой домашний комп, файлы все тестовые и удалять их с РС да и видеть, что сработало намного проще, чем в каталогах. На работе пути ведут в сетевые папки

В приведенном коде нет (во всяком случае, я его не увидел) фрагмента, который занимается переносом в другую папку. Вообще-то, ты писал, что
Цитата: sna4e от Вчера в 21:18
Как переносить в другую папку я понимаю...
но после прочтения скрипта "меня терзают смутные сомнения" (с) "С лёгким паром"

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

Если в имени файла присутствует дата, то обычно её записывают задом наперёд - год-месяц-день. В этом случае при сортировке файлов в папке "по имени" они автоматически сортируются и "по дате создания". Кроме того, такое имя освобождает тебя от необходимости проверять сколько цифр в сегодняшнем числе. Мелочь, конечно, но все-таки на четыре строки кода меньше... (Тебе же, надеюсь, не за количество символов платят, нет?) Опять же, имя файла из одной только даты, без префиксов-суффиксов, ограничивает твою свободу - в следующий раз придётся изобретать какой-то другой способ именования... Написал бы что-то вроде
Код:

imya = convertToURL("D:\Vygruzki\Kristi"+Format(Date,"YYYY.MM.DD")+".xls")

Поиск последней заполненной строки у тебя выглядит... э-э-э... не убедительно. Это делается немного иначе... Загляни в стандартную библиотеку Tools, модуль Misc, найди там функцию GetLastUsedRow. Можешь просто скопировать её к себе в скрипт. Только не забудь изменить тип функции на Long. Так, на всякий случай.
Из этой же библиотеки Tools можешь утащить и функцию OpenDocument. Она сначала делает то, о чем написал rami - перебирает все открытые документы ("роется в памяти") и если не находит нужный - открывает его с диска...

Цитата: sna4e от Сегодня в 10:36
...актуальный вариант остался на работе. В нем я отказался от ВПРа, и переделал счет количества строк.
Полностью одобряю отказ от VLOOKUP'а и последующей замены формул на вычисленные значения. Метод getDataArray почти мгновенно считает значения из нужного диапазона ячеек в массив. Перебрать элементы массива в двух вложенных циклах - доли секунды... И обратный метод setDataArray тоже работает очень быстро... Не удивляйся, если при такой организации работы твой последний MsgBox всегда будет сообщать Затраченное врем¤: 0;
А ещё можно сэкономить кучу времени и кода, если отказаться от полного форматирования документа макросом. Просто создай шаблон, в котором колонки A-J будут иметь правильную ширину и выравнивание, и именно его открывай для создания очередного файла.

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

Тут, наверное, стоит вдаться в в вопрос почему я его начал писать. Это вообще моё первое программирование, приносящее пользу. Ведем учет некоторых штуковин по серийным номерам, к которым подрядчики присылают раз в день файл с ключами. А моя задача обновлять этот файл. Ну и делалось это изначально так: вставляешь в новый файл из старого столбцы ключей и серийников. А потом ВПРом прогоняешь по всему файлу. Мне стало лень делать это ручками и я начал писать этот макрос. А когда количество ключей разрослось до 30000 и макрос начал выполняться в течение 7-8минут, тут уж пришлось разобраться в бинарным поиском и массивами. Кстати, за основу лег Ваш макрос, взятый на этом форуме.
Ну так как делаю я это на добровольных началах у меня нет причин да и оснований менять название с "0текст+текст+текст+дд-мм-гг". Руководству оно нравится - пусть так и остается.

[sna4e]

Если макрос запускается из редактора, то эту часть убирать не надо, она предотвращает закрытие самого редактора в момент выполнения макроса. Если макрос запускается кнопкой, то эта часть не нужна.

Спасибо, это очевидно)