|
Доброго времени суток, Посетитель!
|
|
|
|
|
|
|
|
|
вид форума:
|
| |
|
|
| | Да блин опен офис
Если бы не статья Osmor_a
Это вам ни хухры мухры - или тока для меня 
Вот написал чтоба простую накладную создать - офигеть - ..........
Public Function Create_NAKLADNAYA()
Dim OpenParams()
Dim rst As ADODB.Recordset
Dim PP As Long
Dim INDEX_Sheet As Long 'индекс листа
'Dim i As Long
' Спасибо Osmor иначе ничё не вышло бы
Set oDok = oDesk.loadComponentFromURL(GLB_PATCH_DOCS, "_blank", 0, OpenParams)
' если такой лист имеется
If findSheetIndex(oDok, "Накладная") <> -1 Then
'удаляем лист
Call oDok.getSheets.removeByName("Накладная")
End If
' создадим новый лист после текущего
Call oDok.getSheets.InsertNewByName("Накладная", 1)
INDEX_Sheet = findSheetIndex(oDok, "Накладная") ' получим индекс листа
Set oSheet = oDok.getSheets().getByIndex(INDEX_Sheet) '4- Накладная
Call FUN_Unite("A" & 1 & ":I" & 1, 2) ' A1:I1
Call FUN_IN_DOCS("0", 0, "Продавец:" & FRM_RECEIVE_KLIENT!Rekv1, 2)
Call FUN_Unite("A" & 2 & ":I" & 2, 2)
Call FUN_IN_DOCS("0", "1", "Покупатель:" & FRM_RECEIVE_KLIENT!Rekv2, 2)
Call FUN_Unite("A" & 3 & ":I" & 3, 2)
Call FUN_IN_DOCS("0", "2", "Через кого:" & FRM_RECEIVE_KLIENT!Rekv3, 2)
Call FUN_Unite("A" & 4 & ":I" & 4, 2)
Call FUN_IN_DOCS("0", "3", "Основание:" & FRM_RECEIVE_KLIENT!Rekv4, 2)
Call FUN_Unite("A" & 6 & ":I" & 6, 2)
Set objCel = oSheet.getCellRangeByPosition(0, 5, 8, 5) ' ссылка на ячейку
objCel.CharWeight = 150 'Толщина шрифта
objCel.SetPropertyValue "CharHeight", 14 ' Размер шрифта
Call FUN_IN_DOCS("0", "5", "Накладная № :" & GLB_DOC_NUMBER, 3)
PP = 7
Call FUN_IN_DOCS("0", PP, "№", 3) ' по порядку
Call FUN_Unite("B" & PP + 1 & ":E" & PP + 1, 3)
Call FUN_IN_DOCS("1", PP, "Наименование товара", 3)
Call FUN_IN_DOCS("5", PP, "Ед.изм.", 3)
Call FUN_IN_DOCS("6", PP, "Кол-во", 3)
Call FUN_IN_DOCS("7", PP, "Цена", 3)
Call FUN_IN_DOCS("8", PP, "Сумма", 3)
' задаём диапазон ячеек в одной строке PP - 1
Set objCel = oSheet.getCellRangeByPosition(0, PP, 8, PP)
Call FUN_BORDER
' задаём ширину колонок
Set oCol = oSheet.getColumns().getByIndex(0)
oCol.Width = 700
Set oCol = oSheet.getColumns().getByIndex(5)
oCol.Width = 1700
Set oCol = oSheet.getColumns().getByIndex(6)
oCol.Width = 1700
Set oCol = oSheet.getColumns().getByIndex(8)
oCol.Width = 3400
'Заполнение окна товарами транзакции
Set rst = New ADODB.Recordset ' набор записей
' открываем всю группу в rst.Open транзакции
rst.Open "SELECT USERS_TRANSACTIONS_TBL.* From USERS_TRANSACTIONS_TBL Where (((USERS_TRANSACTIONS_TBL.ID_GROUP_TRANSACTION) = '" & GLB_ID_GROUP_TRANSACTIONS & "')) ", GLB_CONNECTION, adOpenKeyset, adLockOptimistic
If rst.RecordCount = 0 Then Exit Function
If Not rst.BOF Then rst.MoveFirst
PP = 8
Do While Not rst.EOF ' заполняем наименованиями список товаров
Call FUN_IN_DOCS("0", PP, PP - 7, 3) ' № по порядку
Call FUN_IN_DOCS("1", PP, NZVB(rst("COMMODITY_NAME")), 2)
Call FUN_IN_DOCS("5", PP, NZVB(rst("METAGE")), 3)
Call FUN_IN_DOCS("6", PP, NZVB(rst("AMOUNT_TRANZACTION")), 3)
Call FUN_IN_DOCS("7", PP, FUN_IN_Currency(NZVB(rst("PRICE"))), 3)
Call FUN_IN_DOCS("8", PP, FUN_IN_Currency(NZVB(rst("PRICE")) * NZVB(rst("AMOUNT_TRANZACTION"))), 3)
PP = PP + 1
Call FUN_Unite("B" & PP & ":E" & PP, 2) 'слияние
rst.MoveNext
Loop
' задаём диапазон ячеек от A:8 до F:PP - 1
Set objCel = oSheet.getCellRangeByPosition(0, 8, 8, PP - 1)
Call FUN_BORDER
Call FUN_Unite("A" & PP + 1 & ":F" & PP + 1, 3) 'слияние
Call FUN_IN_DOCS("0", PP, "ИТОГО: ", 3)
'Заполняем PP строку формулой вычисляющей суммы по колонкам
Call FUN_IN_DOCS("6", PP, FUN_AMOUNT_CHECK, 3)
Call FUN_IN_DOCS("8", PP, FUN_IN_Currency(FUN_PODITOG_CHECK), 3)
' задаём диапазон ячеек в одной строке PP
Set objCel = oSheet.getCellRangeByPosition(0, PP, 8, PP)
objCel.CharWeight = 150 'Толщина шрифта
Call FUN_BORDER
PP = PP + 2
Call FUN_Unite("A" & PP & ":I" & PP, 3)
'Call FUN_Unite("A" & PP + 1 & ":I" & PP + 1, 3)
Set objCel = oSheet.getCellRangeByPosition(0, PP, 8, PP)
objCel.IsTextWrapped = True ' Переносить по словам
Call FUN_IN_DOCS("0", PP - 1, "Сумма прописью: " & NumStr(FUN_PODITOG_CHECK, True) & " Без НДС. ", 2)
PP = PP + 3
Call FUN_Unite("A" & PP & ":I" & PP, 3)
Call FUN_IN_DOCS("0", PP - 1, "Отпустил_________________________________ Получил_________________________________ ", 2)
rst.Close
Set rst = Nothing
End Function
|
Может можно как то упростить???????
А то мне ещё и счёт фактуру ваять - офанареть | |
| |
| |
| |
|
|
| | И как ускорить загрузку этого офиса,
а то изпрограммы оооооочень долго не могу к нему подключиться... | |
| |
| |
| |
|
|
| | Ещё вопрос как очистить группу ячеек от данных
т.е применить к диапазону ячеек формат ......... какой то чтобы они все пропали
и тада можно будет брать шаблон и очистив в нём лишнее - дело пойдёт быстрее..... | |
| |
| |
| |
|
|
| | АААААААААААААААААА  
кое что получилося - вот Спасибо статье Osmor
http://hiprog.com/index.php?option=com_content&task=view&id=251661586
Во модуль для работы с OpenomOfficem и его Calckom
Option Explicit
Public OpenOffice As Object ' сервис менеджер
Public OOO_Desktop As Object ' рабочий стол
Public OOO_Document As Object ' документ, книга
Public OOO_Sheet As Object ' лист
Public OOO_Index_Sheet As Long ' индекс листа
Public OOO_Range As Object ' Диапазон ячеек
Public Function FUN_Connect_OOO()
' подключение
On Error GoTo FUN_Connect_OOO_Error
'----------------------------------------------------------------------------------------------------------------------------------------------------------------
If IsOpenOfficeConnected() Then Exit Function
Set OpenOffice = CreateObject("com.sun.star.ServiceManager")
Set OOO_Desktop = OpenOffice.createInstance("com.sun.star.frame.Desktop") ' Set OOoIntrospection = CreateUnoService("com.sun.star.beans.Introspection")
'----------------------------------------------------------------------------------------------------------------------------------------------------------------
On Error GoTo 0
Exit Function
FUN_Connect_OOO_Error:
Set OpenOffice = Nothing
Error_String = Err.Description
Call FUN_IN_TXT(FUN_Patch_File(App.Path, "Error.txt"), Now() & " _модуль " & "OOO_MOD" & " _процедура " & "FUN_Connect_OOO" & " ..ошибка." & Error_String)
'_______END_______END_______END_______END_______END_______END_______END
End Function
Function IsOpenOfficeConnected() As Boolean
' проверка подключения может уже подключено
Dim DeskTopbis As Object
On Error GoTo IsOpenOfficeConnected_ERR
IsOpenOfficeConnected = False
If isNullEmpty(OpenOffice) Then Exit Function
Set DeskTopbis = OpenOffice.createInstance("com.sun.star.frame.Desktop")
Set DeskTopbis = Nothing
IsOpenOfficeConnected = True
Exit Function
IsOpenOfficeConnected_ERR:
Set OpenOffice = Nothing
End Function
Function isNullEmpty(ByVal thisVariant As Object) As Boolean
' проверка на пустоту и на нуль
isNullEmpty = IsEmpty(thisVariant) Or IsNull(thisVariant)
End Function
Public Function FUN_OOO_OPEN_BOOCK(STR_PATCH_DOCS As String)
'Функция открытия книги ' Спасибо Osmor_у, иначе ничего не вышло бы
Dim OpenParams()
' загрузить открыть документ ("file:///c:/dev/ooo/test.doc", "_blank", 0, arg())
Set OOO_Document = OOO_Desktop.loadComponentFromURL(STR_PATCH_DOCS, "_blank", 0, OpenParams)
End Function
Public Function ConvertToUrl(strFile) As String
'конвертирует путь MS Windows в URL (RFC 1738)
strFile = Replace(strFile, "\", "/")
' strFile = Replace(strFile, ":", "|")
strFile = Replace(strFile, " ", "%20")
strFile = "file:///" + strFile
ConvertToUrl = strFile
'"file:///C:/1.odt", "_blank", 0, NoArg)
'("file://localhost/C:\TEMP\Ostatki.xls", "_blank", 0, Массив);
End Function
Public Function FUN_IN_DOCS(MyCol, MyRow, MyText, str_Aligment)
' вставка в ячейку
Set OOO_Range = OOO_Sheet.getCellByPosition(MyCol, MyRow)
OOO_Range.ParaAdjust = str_Aligment '3 ' слева2 справа1 центр3
Select Case TypeName(MyText)
Case "String"
If Left(MyText, 1) = "=" Then
OOO_Range.SetFormula MyText
Else
OOO_Range.setString MyText
End If
Case "Double", "Integer", "Long", "Currency"
OOO_Range.SetValue MyText
End Select
End Function
'
Public Function FUN_Unite(Str_Range, str_Aligment As Long, Str_Merge As Boolean)
'Слияние объединять
'Str_Merge-True объединить ячейки диапазона
'str_Aligment - слева2 справа1 центр3
'str_Aligment - 0 не использовать
'Str_Merge - False разьединить ячейки диапазона
Set OOO_Range = OOO_Sheet.getCellRangeByName(Str_Range)
OOO_Range.Merge (Str_Merge)
If str_Aligment <> 0 Then
OOO_Range.ParaAdjust = str_Aligment
End If
End Function
Public Function FUN_CLEAR_Range(Str_Range As String)
' диапазон на этом листе
Set OOO_Range = OOO_Sheet.getCellRangeByName(Str_Range)
' очистка всех значений в диапазоне
OOO_Range.clearContents (1 Or 2 Or 4) 'FlagsVALUE = 1 FlagsDATETIME = 2 FlagsSTRING = 4
OOO_Range.Merge (False) ' объединить-true разьединить - False ячейки диапазона
End Function
Public Function FUN_BORDER_POINT(Str_Range As String)
' бордюры ячеек пример "K1:L11" FUN_MakeCellBorderLine
' получаем ссылку и идём рисовать в = FUN_MakeCellBorderLine
' диапазон на этом листе
Set OOO_Range = OOO_Sheet.getCellRangeByName(Str_Range)
Set OOO_Range.LeftBorder = FUN_MakeCellBorderLine(RGB(0, 0, 0), 0, 5, 0)
Set OOO_Range.RightBorder = FUN_MakeCellBorderLine(RGB(0, 0, 0), 0, 5, 0)
Set OOO_Range.TopBorder = FUN_MakeCellBorderLine(RGB(0, 0, 0), 0, 5, 0)
Set OOO_Range.BottomBorder = FUN_MakeCellBorderLine(RGB(0, 0, 0), 0, 5, 0)
End Function
Public Function FUN_BORDER_CLEAR(Str_Range As String)
' бордюры ячеек пример "K1:L11" FUN_MakeCellBorderLine
' получаем ссылку и идём рисовать в = FUN_MakeCellBorderLine
' диапазон на этом листе
Set OOO_Range = OOO_Sheet.getCellRangeByName(Str_Range)
Set OOO_Range.LeftBorder = FUN_MakeCellBorderLine(RGB(0, 0, 0), 0, 0, 0)
Set OOO_Range.RightBorder = FUN_MakeCellBorderLine(RGB(0, 0, 0), 0, 0, 0)
Set OOO_Range.TopBorder = FUN_MakeCellBorderLine(RGB(0, 0, 0), 0, 0, 0)
Set OOO_Range.BottomBorder = FUN_MakeCellBorderLine(RGB(0, 0, 0), 0, 0, 0)
End Function
Public Function FUN_MakeCellBorderLine(nColor, nInnerLineWidth, nOuterLineWidth, nLineDistance) _
As Object
'Функция создания объекта BorderLine содержащего информацию о линии рамки
'параметры nColor - цвет рамки
'nInnerLineWidth - толщина внутренней линии
' nOuterLineWidth - - толщина внешней линии
' расстояние между внутренней и внешней линией
Dim oSM As Object
Dim oBorderLine As Object
Set oSM = CreateObject("com.sun.star.ServiceManager")
Set oBorderLine = oSM.Bridge_GetStruct("com.sun.star.table.BorderLine")
With oBorderLine
.Color = nColor
.InnerLineWidth = nInnerLineWidth
.OuterLineWidth = nOuterLineWidth
.LineDistance = nLineDistance
End With
Set FUN_MakeCellBorderLine = oBorderLine
End Function
Public Function OOO_IT_IS_SHEET(STR_NAME_SHEET As String) As Boolean
' проверка наличия листа по имени преобразуя имя в индекс OOO_findSheetIndex()
' если такой лист имеется
OOO_IT_IS_SHEET = False
If OOO_findSheetIndex(OOO_Document, STR_NAME_SHEET) <> -1 Then
OOO_IT_IS_SHEET = True
End If
End Function
Function OOO_findSheetIndex(oDoc As Object, sheetName As String) As Integer
'возвращает индекс листа книги переданной в качестве параметра по его имени
Dim i As Integer
For i = 0 To OOO_Document.Sheets.Count - 1
If oDoc.Sheets.getByIndex(i).Name = sheetName Then
OOO_findSheetIndex = i
Exit Function
End If
Next i
OOO_findSheetIndex = -1
End Function
Public Function OOO_DELETE_SHEET(STR_NAME_SHEET As String) As Boolean
'удаляем лист
Call OOO_Document.getSheets.removeByName(STR_NAME_SHEET)
End Function
Public Function FUN_Clear_OOO()
On Error GoTo exit_Function
' очистка переменных OOO
Set OOO_Document = Nothing
Set OOO_Sheet = Nothing
Set OOO_Desktop = Nothing
Set OpenOffice = Nothing
exit_Function:
End Function
|
| |
| |
| |
| |
|
|
| | Это конечно не полный набор, но пока я вот до чего долопатился........ и выкладываю - для Всех, кому надо начинать, но не знает как.  | |
| |
| | |
|
| |
|
|
| | ну не совсем ворд
скорее экцель
там такие же таблицы , ячейки , столбцы, строки | |
| |
| |
| |
|
|
| | Ну я так понимаю надо VB ставить, в нем форму создавать, потом на этоу форму весь этот код копировать, потом компилировать? Что-то не то. Стрункцу по применению плиз. Или в компилированном состоянии. Хоцца поглядеть что это за хрень така.
А вдруг что-то действительно стоящее?  | |
| |
| | |
| |
|
| |
|
|
| | Abu тебе, а не пример
Щас сам допрёшь:
сначала ставим на машину Openoffice - без него трудна будет .....
ХОТЯБА одно его приложение - Calc
в поле1 пишем обычный путь - всем понятный C:\File.ods
на клик кнопки - вешаем код:
dim STR_PATCH_DOCS as string
STR_PATCH_DOCS-=ConvertToUrl(me! поле1)
call UN_OOO_OPEN_BOOCK(STR_PATCH_DOCS As String) '- открыть книгу
' вставка данных в ячейку
call FUN_IN_DOCS(MyCol, MyRow, MyText, str_Aligment)
'например
call FUN_IN_DOCS(0, 0, "ПРИВЕТ МИР" , 3)
=========================================
и перестань меня удивлять тупизной - я сам такой!!!  | |
| |
| | |
|
| |
|
|
| |
от ссыhttp://udk.openoffice.org/common/man/tutorial/writerdemo.html
| |
| |
| |
HiProg.com - Технологии программирования
|
