OpenFile

[bigor]

файл занят

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

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

doc = StarDesktop.LoadComponentFromURL(ConvertToUrl(afff(i)), "_blank", 0, Array())
        ' получить текст из открытого документа
        ' sText = doc.Text.String
        ' записать текст в текущий документ
        ThisComponent.Text.string=doc.Text.String  & Chr(13) думаю, что последний ThisComponent будет ссылаться на вновь открытый файл, т.е. получается копирование в себя

[Ципихович Эндрю]

голову сломать можно, подскажите, в коде:
REM Листинг 243. Вставка простого текста в начале и конце документа.

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

Sub InsertSimpleText

  Dim oText As Object
  oText = ThisComponent.Text
  REM Вставим некоторый простой текст в начале
  oText.insertString(oText.getStart(), _
  "Начало текстового объекта." & CHR$(13), False)
  REM Добавим новый абзац в конце
  oText.InsertControlCharacter(oText.getEnd(),_
  com.sun.star.text.ControlCharacter.APPEND_PARAGRAPH, False)

End Subкак сказанное
REM Добавим новый абзац в конце
заменить на
REM Добавим некоторый простой текст2

спасибо

[bigor]

тут то все логично,

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

Sub InsertSimpleText

  Dim oText As Object
  oText = ThisComponent.Text
  REM Вставим некоторый простой текст в начале
  oText.insertString(oText.getStart(), _
  "Начало текстового объекта." & CHR$(13), False)
  REM Добавим новый абзац в конце
  oText.IinsertString(oText.getEnd(),_
  "Конец текстового объекта." & CHR$(13), False)

End Sub

[Ципихович Эндрю]

выделяет\не пропускает, последняя строка

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

oText.IinsertString(oText.getEnd(),_
  "Конец текстового объекта." & CHR$(13), False)как поправить?

[bigor]

Я слеповат, уберите одно I в IinsertString

[Ципихович Эндрю]

мой итоговый код макроса:

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

Sub OpenFile()

' очищаем текущий документ
ThisComponent.Text.string=""
Dim doc As Object
Dim afff(1) As String
afff(0) = "I:\Российская Федерация\5. ГОСТ Р 52289-2019_01.04.2020.htm"
afff(1) = "I:\Российская Федерация\21. Вред здоровью_18.01.2012.htm"
Dim i As Long
Dim sText As String
Dim oText As Object
' объект текущий документ
  oText = ThisComponent.Text
for i=0 to ubound(afff)
' Print afff(i)
    doc = ThisComponent.CurrentController.Frame
        ' открываем документ, путь к документу - afff(i)
        doc = StarDesktop.LoadComponentFromURL(ConvertToUrl(afff(i)), "_blank", 0, Array())
        ' получить текст из вновь открытого документа
        sText = doc.Text.String
        ' закрыть файл
        doc.close(True)
        If i=0 Then
        ' вставим текст в начале текущего документа
  oText.InsertString(oText.getStart(), _
  sText & CHR$(13) & "+++++++++++++++++++++++++++++++++++++++++++++" & CHR$(13), False)
  Else
  ' вставим текст в конце текущего документа
  oText.InsertString(oText.getEnd(),_
  sText & CHR$(13) & "+++++++++++++++++++++++++++++++++++++++++++++" & CHR$(13), False)
  End If
     Next

MsgBox "РАБОТА МАКРОСА ЗАВЕРШЕНА"

End Subподскажите пожалуйста, в ходе выполнения макроса выделяет и не пропускает коду далее выполнятся на строке

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

doc = ThisComponent.CurrentController.Frameи самое интересное в этот момент уже оба документа вставились, такое впечатление, что цикл пошёл выполняться на третий круг-я его этого не просил))

[bigor]

А зачем вам doc = ThisComponent.CurrentController.Frame? И как то много лишнего намешано.

[Ципихович Эндрю]

прошу помощи так как по отдельности два макроса работают без ошибок, а соединив в один макрос падает на строке:

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

oSearchDescr = oDoc.CreateSearchDescriptor()вот мой код:

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

Sub OpenFile()

' очищаем текущий документ
ThisComponent.Text.string=""
Dim doc As Object
Dim afff(1) As String
afff(0) = "I:\Российская Федерация\5. ГОСТ Р 52289-2019_01.04.2020.htm"
afff(1) = "I:\Российская Федерация\21. Вред здоровью_18.01.2012.htm"
Dim i As Long
Dim sText As String 'текст длинной до 65 535 символов
Dim oText As Object
' объект текущий документ
  oText = ThisComponent.Text
for i=0 to ubound(afff)
' Print afff(i)
        ' открываем документ, путь к документу - afff(i)
        doc = StarDesktop.LoadComponentFromURL(ConvertToUrl(afff(i)), "_blank", 0, Array())
        ' получить текст из вновь открытого документа
        sText = doc.Text.String
        ' закрыть файл
        doc.close(True)
  ' вставить текст в конце текущего документа
  oText.InsertString(oText.getEnd(),_
  sText & CHR$(13) & "+++++++++++++++++++++++++++++++++++++++++++++" & CHR$(13), False)
     Next
     
    Dim oDoc As Object
  oDoc = ThisComponent
Dim oSearchDescr 'Описатель поиска
oSearchDescr = oDoc.CreateSearchDescriptor()
With oSearchDescr
  .SearchString = Chr(160)
  End With
Dim oAllFound 'Все найденные элементы
oAllFound = oDoc.findAll(oSearchDescr)
MsgBox "Количество всех найденных Chr(160): " & oAllFound.getCount()


MsgBox "РАБОТА МАКРОСА ЗАВЕРШЕНА" & CHR$(13)  & _
   "Вставлено в текущий доумент: " & ubound(afff) + 1 & " документов"

End Subспасибо

[bigor]

Смотрел с телефона. Но мне кажется, что oDoc, нужно прописать вместе с oText, потому что после закрытия документов в циклах, не ясно, что у нас представляет ThisComponent

[sokol92]

Кстати, выгрузил из Консультанта+ документ

ГОСТ Р 52289-2019. Национальный стандарт Российской Федерации. Технические средства организации дорожного движения. Правила применения дорожных знаков, разметки, светофоров, дорожных ограждений и направляющих устройств"
(утв. Приказом Росстандарта от 20.12.2019 N 1425-ст)

в формате MS Word (*.docx).

Открывается в LibreOffice не медленнее, чем в MS Word. Каких-то проблем с качеством не замечено.

[sokol92]

не ясно, что у нас представляет ThisComponent

Если макрос Basic находится в библиотеке документа, то ThisComponent является ссылкой на этот документ.
Если макрос находится в библиотеке приложения (в дереве макросов это ветви "Мои макросы" и "Макросы приложения"), то ThisComponent указывает на последний "активированный" документ LibreOffice.

А.Питоньяк указывает в свой знаменитой книге OOME_4_0.odt, что "The value of ThisComponent is set when the macro begins running and then it is not changed". В моей версии LO 7.6.4.1 это не так.

Поместим следующий макрос в любую библиотеку из раздела "Мои макросы", откроем (создадим) любой документ и выполним макрос. В сообщениях Msgbox будет различные тексты.

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

Sub TestThisComponent()
  Dim oDoc
  Msgbox ThisComponent.Title
  oDoc = StarDesktop.LoadComponentFromUrl("private:factory/scalc", "_blank", 0, Array())
  Msgbox ThisComponent.Title
End Sub
Кстати, следует учесть, что книги А.Питоньяка написаны достаточно давно и могут не соответствовать текущим версиям LibreOffice.

Например, ограничение длины текстовой строки из сообщения выше:

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

Dim sText As String 'текст длинной до 65 535 символовуже давно не актуально. 

[bigor]

я думаю у тс, второй вариант, и если дополнить макрос

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

Sub TestThisComponent()
  Dim oDoc
  Msgbox ThisComponent.Title
  oDoc = StarDesktop.LoadComponentFromUrl("private:factory/scalc", "_blank", 0, Array())
  Msgbox ThisComponent.Title
  oDoc.Close true
  Msgbox ThisComponent.Title
End Sub
, то последний msgbox вываливается в ошибку, т.к. ThisComponent не имеет свойства Title, следовательно это не первоначальный документ

[Ципихович Эндрю]

Кстати, выгрузил из Консультанта+ документ

ГОСТ Р 52289-2019. Национальный стандарт Российской Федерации. Технические средства организации дорожного движения. Правила применения дорожных знаков, разметки, светофоров, дорожных ограждений и направляющих устройств"
(утв. Приказом Росстандарта от 20.12.2019 N 1425-ст)

в формате MS Word (*.docx).

Открывается в LibreOffice не медленнее, чем в MS Word. Каких-то проблем с качеством не замечено

так а мне нужны файлы в первую очередь в формате хтмл, а качать в двух форматах не есть хорошо, лучше одну проблему побороть))

книги А.Питоньяка

а мне отложилось, что он Эндрю, не?


соединил два кода-они работают-проверял
а вместе выёживаются))

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

Sub FileSortOpenDeleteChr160

Dim arr, arr1
Dim i As Long
Dim sFileName
Dim sDir As String
sDir="I:\Российская Федерация\"
Dim oFS As Object
' Создаём объект для доступа к файловой системе
oFS = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
' Проверяем существование каталога
If Not oFS.exists(sDir) Then
Print "Каталог " & sDir & " не существует, программа далее не будет продолжаться."
Exit Sub
End If
GlobalScope.BasicLibraries.loadLibrary("ScriptForge")
sfilename=files(sDir)
redim arr(1,ubound(sfilename))
for i= 0 to ubound(sfilename)
arr(0,i)=int(split(getname(sfilename(i)),".")(0))
arr(1,i)=convertfromurl(sfilename(i))
Next
arr1=sortcolumns(arr,0)

Dim sFiles_print As String
sFiles_print = ""
Dim last4chr As String
last4chr = ""
'очищаем текущий документ
ThisComponent.Text.String=""
Dim doc As Object
Dim sText As String
Dim oText As Object
'объект текущий документ
  oText = ThisComponent.Text
  Dim oDoc As Object
  'объект текущий документ
for i=0 to ubound(sfilename)
' print arr1(1,i) вывод пути и имени файла после сортировки
' накапливаются в переменную пути и имени файла после сортировки с разделитем, которым является абзац
sFiles_print = sFiles_print & arr1(1,i) & Chr(13)
last4chr = arr1(1,i)
last4chr = LCase(Right(last4chr, 4))
If last4chr = ".htm" Then 'вариант похуже, проверяет только вхождение If InStr(last4chr, ".htm") > 0
'открываем документ, путь к документу - last4chr
        doc = StarDesktop.LoadComponentFromURL(last4chr, "_blank", 0, Array())
        'получить текст из вновь открытого документа
        sText = doc.Text.String
        ' закрыть файл
        doc.close(True)
  'вставить текст в конце текущего документа
  oText.InsertString(oText.getEnd(),_
  sText & CHR$(13) & "+++++++++++++++++++++++++++++++++++++++++++++" & CHR$(13), False)
End If
next

'вывод результата в текущем документе - пути к файлам из каталога, которые программой отсортированы
'ThisComponent.Text.string=sFiles_print
'MsgBox sFiles_print
'print sFiles_print

Dim oSearchDescr 'описатель поиска
oSearchDescr = oDoc.CreateSearchDescriptor()
With oSearchDescr
  .SearchString = Chr(160)
  End With
Dim oAllFound 'Все найденные элементы
oAllFound = oDoc.findAll(oSearchDescr)
'MsgBox "Количество всех найденных Chr(160): " & oAllFound.getCount()
If  oAllFound.getCount() > 0 Then
With oSearchDescr
  .SearchString = Chr(160)
  .ReplaceString = " "
End With
oDoc.ReplaceAll(oSearchDescr)
End If

MsgBox "РАБОТА МАКРОСА ЗАВЕРШЕНА" & CHR$(13)  & _
   "Вставлено документов в текущий доrумент: " & ubound(afff) + 1 & CHR$(13)  & _
   "Количество сделанных замен Chr(160) на пробел: " & oAllFound.getCount()


End Subпадает на строке

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

doc = StarDesktop.LoadComponentFromURL(last4chr, "_blank", 0, Array())нуждаюсь в помощи....

[bigor]

третий раз на одни грабли. Когда я писал макрос для сортировки имен файлов, была задача красиво их показать, поэтому arr(1,i)=convertfromurl(sfilename(i)) У вас задача использовать имя для открытия файла, поэтому или убрать convertfromurl в этой строке или добавить converttourl для last4chr

[Ципихович Эндрю]

добавить converttourl для last4chr

у меня так и было, была ошибка - я убрал и снова ошибка, так как ошибки отображаются в форме - то есть не скопировать я эти ошибки на этой строке НЕ сравнивал, ладно поправлю-отпишусь))