dg333
Advanced Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Вот такой макросик:
Код: Option Explicit
Global globalDoc_OOoExtension as String 'extension used for the OOo filefornat
Global globalDoc_MSExtension as String 'extension used for the MS Office fileformat
Global globalDoc_FilterName as String 'FilterName for the export
Sub ExportAsMSOffice
Dim ExportURL as new com.sun.star.util.URL 'the MS Office version of that document
Dim oDoc as Object
Dim opts(3) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
' if doc hasn't been saved yet we stop
If oDoc.getLocation() = "" Then Exit Sub '
' set the globalDoc_* variables so we know what export filters and file extension we need
determineDocInfo(oDoc)
' compose new URL struct for MS Office document
ExportURL = composeNewURL(oDoc.getLocation())
opts(0).Name = "FilterName"
opts(0).Value = globalDoc_FilterName
opts(1).Name = "Overwrite"
opts(1).Value = True
opts(2).Name = "InteractionHandler"
opts(2).Value = ""
MsgBox oDoc.getLocation() & Chr$(13) & ExportURL.Complete
oDoc.storeToURL(ExportURL.Complete,opts())
'MsgBox CurURL.Complete & " to" & Chr$(13) & ExpURL.Complete
End Sub
Function ReplaceExtension( filename$ as String) as String
'Dim OldExt as String
'OldExt = Right (filename, 3 )
ReplaceExtension = Left( filename, (Len(filename) - Len(globalDoc_OOoExtension)) ) & globalDoc_MSExtension
'MsgBox filename & " " & ReplaceExtension
End function
Sub determineDocInfo(oDoc as Object) ' set the global variables
If oDoc.supportsService("com.sun.star.text.TextDocument") Then
globalDoc_FilterName = "MS Word 97"
globalDoc_OOoExtension = "sxw"
globalDoc_MSExtension = "doc"
Elseif oDoc.supportsService("com.sun.star.sheet.SpreadsheetDocument") Then
globalDoc_FilterName = "MS Excel 97"
globalDoc_OOoExtension = "sxc"
globalDoc_MSExtension = "xls"
Elseif oDoc.supportsService("com.sun.star.presentation.PresentationDocument") Then
globalDoc_FilterName = "MS PowerPoint 97"
globalDoc_OOoExtension = "sxi"
globalDoc_MSExtension = "ppt"
End if
End Sub
Function composeNewURL(stringURL as String) as com.sun.star.util.URL
Dim CurrentURL as new com.sun.star.util.URL 'the document you are editing
Dim NewURL as new com.sun.star.util.URL
Dim URLParser as Object, tmp as String
CurrentURL.Complete = stringURL
URLParser = createUnoService("com.sun.star.util.URLTransformer")
URLParser.parseStrict(CurrentURL)
tmp = CurrentURL.Protocol & CurrentURL.User & CurrentURL.Password
' URL.Server and URL.Port make no sence if the document is local
If (CurrentURL.Server <> "") Then
' CurURL.Server returns "" as a String if not set, thus we skip Server and Port
tmp = tmp & CurrentURL.Server & CurrentURL.Port
End if
' tmp = tmp & CurrentURL.Path & "exported_" & ReplaceExtension(CurrentURL.Name) & CurrentURL.Arguments & CurrentURL.Mark
tmp = tmp & CurrentURL.Path & ReplaceExtension(CurrentURL.Name) & CurrentURL.Arguments & CurrentURL.Mark
NewURL.Complete = tmp
URLParser.parseStrict(NewURL)
composeNewURL = NewURL
End Function
|
Данный макрос экспортирует текущий документ в формат MS Office, причём автоматически выбирает формат Word/Excel/PowerPoint в зависимости от типа документа. Поэтому достаточно повесить одну-единственную кнопку в Writer/Calc/Impress, к которой макрос и прицепить.
Обратить внимание на строки:
Код: ' tmp = tmp & CurrentURL.Path & "exported_" & ReplaceExtension(CurrentURL.Name) & CurrentURL.Arguments & CurrentURL.Mark
tmp = tmp & CurrentURL.Path & ReplaceExtension(CurrentURL.Name) & CurrentURL.Arguments & CurrentURL.Mark |
Закомменнтированный вариант — оригинальный, раскомментированный — мой, мне удобнее, когда файл экспортируется под тем же именем.
К сожалению, я не помню, кто автор, и вообще откуда я его взял (он у меня ещё со времён ООо 1.0.1), так что если у кого будет информация — прошу дополнить. Думал, что его потерял в результате многочисленных переустановок и перехода на 2.0, а поиск по Интернету ничего не дал. Случайно нашёл в одном из дальних углов жёсткого диска, поэтому выкладываю сюда — чтоб самому не потерять, ну, и другим к пользе.
Добавлено:
Да, забыл сказать: по завершении экспорта макрос выводит окошко с именем экспортированного файла. Если в имени/пути есть кириллица, выглядит страшно, но пугаться не стоит, всё в порядке  |
