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
|