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

[sna4e]

Последний вариант кода в результате получился такой:

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

Sub TEST_NEW
Dim Doc As Object
Dim Sheet As Object
Dim Col As Object
'Dim 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
DIM Cell AS OBJECT
start = now
Doc = ThisComponent
Doc1 = ThisComponent.CurrentController.Frame
Sheet = Doc.getSheets.getByIndex(0)
rem ----------------------------------------------------------------------
VstSBR ("$K$1")
VstSBR ("$L$1")
viravn ("$C$1:$C")
viravn ("$E$1:$E")
viravn ("$H$1:$H")

n=StarDesktop.Frames.Count
For r=0 To n-1
s=StarDesktop.Frames(r)
IF left(s.Title, 17) ="Сводный+файл+" Then'
s.Close(True)
Perenos_TEST
Exit For
END IF
Next
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 -------------------------------------------------------------
Vstavka_J ' Установка верных данных в J

Sheet.Columns.removeByIndex(10, 2) rem удаление столбцов K и L
rem -------------------------------------------------------------------
Col = Sheet.Columns(9) rem столбец J установка оптимальной длины.
col.OptimalWidth = True
rem -------------------------------------------------------------------
dim i as integer
dim imya_1, adres, adres1 as string
i=1
adres ="K:\Некоторый путь\Сводный+файл+"
adres1="K:\Некоторый путь\архив\Сводный+файл+"
imya = Format(Date,"DD.MM.YY")
IF FileExists(ConvertToUrl(adres+imya+".xls")) or FileExists(ConvertToUrl(adres1+imya+".xls")) THEN
imya_1 =imya
DO WHILE FileExists(ConvertToUrl(adres+imya_1+".xls")) or FileExists(ConvertToUrl(adres1+imya_1+".xls"))
i = i+1
imya_1 =imya+"_"+i
LOOP
ELSE imya_1 =imya
END IF
Dim Dummy()
Doc.storeAsURL(ConvertToUrl(adres+imya_1+".xls"), Dummy())
finish = now
res = finish - start
'----------------------------------------------------------

Dim FileNo As Integer
Dim CurrentLine As String
Dim Filename As String
DIM u_name as String
DIM pc_name as String
u_name = ENVIRON("USERNAME")
pc_name = ENVIRON("COMPUTERNAME")
Filename = "K:/Некоторый путь/renew_log.txt" ' Определение имени файла
FileNo = Freefile ' Установление свободного файлового манипулятора
Open Filename For Append As #FileNo ' Открытие файла (в режиме на запись)
Print #FileNo, u_name+CHr(9)+pc_name+CHr(9)+start+CHr(9)+res+CHr(9)+kolvo_strok(4)+CHr(9)+imya_1+CHr(9)+kolvo_strok(9)' сохранение строки
Close #FileNo
end sub

Function binFind(key, aData)
DIM found as boolean
Dim l&, r&, m&, N&, i&
l=LBound(aData)+1
r=UBound(aData)
N=r
Do
m=l+Int((r-l)/2)
If aData(m)(1)=key Then
found= TRUE
Elseif aData(m)(1)<key Then l=m+1
Else r=m-1
EndIf
LOOP UNTIL l>r OR found =TRUE
If  found =TRUE Then
binFind= m
Else
binFind = -1
EndIf

End Function
Function kolvo_strok(key)
Dim Doc As Object
Dim Sheet As Object
Dim Col As Object
Doc = ThisComponent
Sheet = Doc.getSheets.getByIndex(0)
Col = Sheet.Columns(key)
kolvo_strok = Col.computeFunction(com.sun.star.sheet.GeneralFunction.COUNT)
End function

Sub VstSBR (key AS String)
dim val as String
IF key = "$K$1" THEN
val = "$E$1:$E$"+kolvo_strok(4)
ELSEIF key = "$L$1" THEN
val = "$J$1:$J$"+kolvo_strok(4)
END IF
n=StarDesktop.Frames.Count
For i=0 To n-1
s=StarDesktop.Frames(i)
IF left(s.Title, 17) ="Сводный+файл" Then'
Exit For
END IF
Next
dim document   as object
dim dispatcher as object
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = val
dispatcher.executeDispatch(s, ".uno:GoToCell", "", 0, args1())
dispatcher.executeDispatch(s, ".uno:Copy", "", 0, Array())
dim args2(0) as new com.sun.star.beans.PropertyValue
args2(0).Name = "ToPoint"
args2(0).Value = key
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args2())
dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array())
End Sub

SUB Vstavka_J
Const notFound="" ' Строка, которую нужно вписывать, если элемент не найден в Справочнике
Dim oSheets As Variant
Dim inSheet As Variant
Dim outSheet As Variant
Dim inRange As Variant ' Справочник как диапазон ячеек
Dim outRange As Variant
Dim finRange As Variant ' Выходной диапазон ячеек
Dim aData As Variant ' Данные Справочника
Dim aOut As Variant ' Массив строк результата
Dim outAddress As New com.sun.star.table.CellRangeAddress
Dim z As Long
DIM adr_mass as String
Dim foundIndex As Long
oSheets = ThisComponent.getSheets()
inSheet = oSheets.getByName("Лист1")
inRange = inSheet.getCellRangeByName("J1:L"+kolvo_strok(10))
Dim aSortFields(0) As New com.sun.star.util.SortField
aSortFields(0).Field = 1
aSortFields(0).SortAscending = TRUE
Dim aSortDesc(1) As New com.sun.star.beans.PropertyValue
aSortDesc(0).Name = "SortFields"
aSortDesc(0).Value = aSortFields()
  aSortDesc(1).Name = "ContainsHeader"
aSortDesc(1).Value = true
inRange.sort(aSortDesc)
aData = inRange.getDataArray()

outSheet = oSheets.getByName("Лист1")
outRange = outSheet.getCellRangeByName("A1:J"+kolvo_strok(4))
outAddress = outRange.getRangeAddress()
aOut = outRange.getDataArray()
For z = LBound(aOut)+1 To UBound(aOut)
foundIndex = binFind(Trim(aOut(z)(4)), aData)
If foundIndex >= 0 Then
aOut(z)(9) = aData(foundIndex)(2)
Else
aOut(z)(9) = notFound + aOut(z)(9)
EndIf
Next z
outRange.setDataArray(aOut)
END SUB

Sub viravn (key AS String)
dim document   as object
dim dispatcher as object
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Value = key+kolvo_strok(4)
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
dim args2(0) as new com.sun.star.beans.PropertyValue
args2(0).Name = "HorizontalJustification"
args2(0).Value = com.sun.star.table.CellHoriJustify.CENTER
dispatcher.executeDispatch(document, ".uno:HorizontalJustification", "", 0, args2())
End Sub

SUB Perenos_TEST
Dim adres as String
Dim adres1 as String
Dim NextFile As String
adres ="K:\Некоторый путь\"
adres1="K:\Некоторый путь\архив\"
NextFile =Dir(adres, 0)
While MID(NextFile, 1, 18) <> "Сводный+файл+"
NextFile =Dir
Wend
FileCopy(adres+NextFile, adres1+NextFile)
Kill(adres+NextFile)
END Sub

[sna4e]

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

Не могу найти, а интересно.

[rami]

Не могу найти, а интересно.

На главной странице форума забейте в поиск Filename

[sna4e]

Не могу найти, а интересно.

На главной странице форума забейте в поиск Filename

Нашел только про сохранение файла в csv. А вот возможно ли писать в xls таким же образом? Или только открывая его невидимым и вставляя данные массивом?

[rami]

Нашел только про сохранение файла в csv. А вот возможно ли писать в xls таким же образом?

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

Или только открывая его невидимым и вставляя данные массивом?

В книге Learn OpenOffice.org Spreadsheet Macro Programming в главе Глава 9. Создание завершенного приложения есть заголовок Выполнение всего в скрытом режиме, там можно прочитать: "Если Вы теперь вызовете макрос из командной строки (как мы научимся делать в следующем разделе, Выполнение макросов из командной строки), то ничто не произойдет — во всяком случае явно. Однако, если Вы посмотрите вашу электронную таблицу, то Вы обнаружите, что она была на самом деле обновлена."

Возможно пригодится, но я подобными вещами не баловался.

[ost]

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

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

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

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

Речь идет об открытии документа в скрытом режиме, что-то типа:

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


aArgs(0).Name = "Hidden"
aArgs(0).Value = True

oDoc= StarDesktop.LoadComponentFromUrl(sFileNameLongUrlOld, "_blank", 0, aArgs()) 'открываем файл

или о чем-то другом?