Public Function FUN_CREATE_COMMODITY_CHECK() As Boolean
' создание документа "Товарный_Чек" Улучшенное
Dim OpenParams()
Dim rst As ADODB.Recordset
Dim PP As Long
' Спасибо Osmor_у, иначе ничео не вышло бы
On Error GoTo FUN_CREATE_COMMODITY_CHECK_Error
'----------------------------------------------------------------------------------
FUN_CREATE_COMMODITY_CHECK = False
' если такого листа нет
If OOO_findSheetIndex(OOO_Document, "Товарный_Чек") = -1 Then
Call MsgBox("В документах не обнаружен лист <<Товарный_Чек>>", vbCritical)
Exit Function
End If
' если такого листа нет
OOO_Index_Sheet = OOO_findSheetIndex(OOO_Document, "Товарный_Чек") ' получим индекс листа
Set OOO_Sheet = OOO_Document.getSheets().getByIndex(OOO_Index_Sheet)
OOO_Sheet.CharWeight = 75
OOO_Sheet.CharHeight = 10
OOO_Sheet.CharFontName = "TimesNewRoman" ' Наименование шрифта
' очистить диапазон под новые данные
Call FUN_CLEAR_Range("A" & PP + 1 & ":J" & 41)
' очистить бордюры диапазона
Call FUN_BORDER_CLEAR("A" & PP + 1 & ":J" & 41)
PP = 0
Call FUN_IN_DOCS("0", PP, "Организация: " & GLB_FIRMA, 2)
PP = PP + 1
Call FUN_Unite("A" & PP & ":I" & PP, 2, True) 'слияние PP на единицу болше (чёт с 1)
PP = PP + 1
Set OOO_Range = OOO_Sheet.getCellRangeByPosition(0, PP, 6, PP)
OOO_Range.CharHeight = 18 ' size Размер шрифта
Call FUN_IN_DOCS("0", PP, "Товарный чек № " & GLB_DOC_NUMBER & " от " & GLB_DOC_DATE, 3)
PP = PP + 1
Call FUN_Unite("A" & PP & ":I" & PP, 3, True) 'слияние PP на единицу больше (чёт с 1)
'' задаём ширину колонокSet OOO_Colonka =
OOO_Sheet.getColumns().getByIndex(0).Width = 700
OOO_Sheet.getColumns().getByIndex(5).Width = 1700
OOO_Sheet.getColumns().getByIndex(6).Width = 1700
OOO_Sheet.getColumns().getByIndex(8).Width = 2800
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_DOC & "')) ", GLB_CONNECTION, adOpenKeyset, adLockOptimistic
If rst.RecordCount = 0 Then Exit Function
If Not rst.BOF Then rst.MoveFirst
PP = PP + 1
Do While Not rst.EOF ' заполняем наименованиями
Call FUN_IN_DOCS("0", PP, PP - 3, 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, NZVAL(rst("AMOUNT_TRANZACTION")), 3)
Call FUN_IN_DOCS("7", PP, FUN_Currency_IN_String_DOCS(NZVB(rst("PRICE"))), 3)
Call FUN_IN_DOCS("8", PP, FUN_Currency_IN_String_DOCS(NZVB(rst("PRICE")) * NZVAL(rst("AMOUNT_TRANZACTION"))), 3)
PP = PP + 1
Call FUN_Unite("B" & PP & ":E" & PP, 2, True) 'слияние
rst.MoveNext
Loop
Call FUN_Unite("A" & PP + 1 & ":F" & PP + 1, 3, True) ' слияние
Call FUN_IN_DOCS("0", PP, "Всего: ", 3)
'Заполняем PP строку суммы по колонкам
Call FUN_IN_DOCS("6", PP, FUN_AMOUNT_DOC, 3)
Call FUN_IN_DOCS("8", PP, FUN_Currency_IN_String_DOCS(FUN_PODITOG_DOC), 3)
Set OOO_Range = OOO_Sheet.getCellRangeByPosition(0, PP, 8, PP)
OOO_Range.CharWeight = 150
Call FUN_BORDER_POINT("A5:I" & PP + 1, 5) ' рисуем бордюрs на все строки
PP = PP + 2
Call FUN_Unite("A" & PP & ":I" & PP, 3, True) ' слияние
Set OOO_Range = OOO_Sheet.getCellRangeByPosition(0, PP, 8, PP)
OOO_Range.IsTextWrapped = True ' Переносить по словам
Call FUN_IN_DOCS("0", PP - 1, "Сумма прописью: " & NumStr(FUN_PODITOG_DOC, True) & " Без налога НДС. ", 2)
PP = PP + 3
Call FUN_Unite("A" & PP & ":I" & PP, 3, True) 'слияние
Call FUN_IN_DOCS("0", PP - 1, "Отпустил ________________________ " & GLB_USER_NAME, 2)
rst.Close
Set rst = Nothing
'Set OOO_Sheet = Nothing
'Set OOO_Document = Nothing
FUN_CREATE_COMMODITY_CHECK = True
'----------------------------------------------------------------------------------
On Error GoTo 0
Exit Function
FUN_CREATE_COMMODITY_CHECK_Error:
Call FUN_IN_TXT(FUN_Patch_File(App.Path, "Error.txt"), "Error " & Err.Number & " (" & Err.Description & ") in procedure FUN_CREATE_COMMODITY_CHECK of Module DOCS_MOD")
End Function
|