Форумы HiProg.com - MS ACCESS, VBA, VB

 

Ответить на сообщение

Вернуться к теме

Вы отвечаете на сообщение:

ник: Силыч
Тема в общем звучит так:
1. Создать функцию RunEval

Function RunEval(fx)
    On Error GoTo re2389457
    RunEval = Eval(fx)
    Exit Function
re2389457:
    MsgError "Calculate"
    Exit Function
End Function


2. в кач-ве параметров передавать ей строку формул/значений
3. формулы предоставлять пользователю на псевдоязыке, например функция П("<ИМЯПОЛЯ>")
должна возвращать значение поля текущей строки текущего рекордсета/даташита
4. затем, например, пробегая по рекордсету с описанными расчитываемыми полями для него, запускать формулы/значения на расчет через RunEval...


формулы из XMLя, если использовать компоненту типа листа Excel, я грузил так примерно:


    '-- строки
    SetStatus "Строки..."
    For i = 1 To cntRows
        Set elmRow = nlRows.item(i - 1)
        For j = 1 To elmRow.childNodes.length
            Set elm = elmRow.childNodes.item(j - 1)
            If Not elm Is Nothing Then
                c1 = elm.getAttribute("cell1") & (i + cntStartRow)
                c2 = Nz(elm.getAttribute("cell2"), "")
                fl = Nz(elm.getAttribute("formula"), "")
                If Len(fl) <> 0 Then
                    fl = StrReplace(1, fl, "#", CStr(i + cntStartRow))
                End If
                CT.range(c1).Locked = Nz(elm.getAttribute("locked"), False)
                CT.range(c1).HAlignment = Nz(elm.getAttribute("halign"), ssHAlignRight)
                CT.range(c1).VAlignment = Nz(elm.getAttribute("valign"), ssVAlignCenter)
                CT.range(c1).NumberFormat = Nz(elm.getAttribute("format"), "Text")
                If Len(fl) = 0 Then
                    If CT.range(c1).NumberFormat = "Text" Then
                        CT.range(c1) = "'" & elm.getAttribute("value")
                    Else
                        CT.range(c1) = elm.getAttribute("value")
                    End If
                Else
                    CT.range(c1).formula = "=" + fl
                End If
                CT.range(c1).Font.Size = 8
                CT.range(c1).Font.name = "Tahoma"
            End If
        Next j
    Next i
..........................................................
    '-- total
    SetStatus "Суммы..."
    For i = 1 To cntTotal
        CT.rows(i + cntStartRow).Font.Bold = False
        CT.rows(i + cntStartRow).Interior.Color = "silver"
        CT.rows(i + cntStartRow).NumberFormat = "Text"
        CT.rows(i + cntStartRow).formula = ""
        Set elmRow = nlTotal.item(i - 1)
        For j = 1 To elmRow.childNodes.length
            Set elm = elmRow.childNodes.item(j - 1)
            If Not elm Is Nothing Then
                c1 = elm.getAttribute("cell1") & (i + cntStartRow)
                c2 = Nz(elm.getAttribute("cell2"), "")
                fl = Nz(elm.getAttribute("formula"), "")
                If Len(fl) <> 0 Then
                    '-- переписать в дальнейшем - на автоопределение номера между ##
                    fl = StrReplace(1, fl, "#0#", CStr(i + cntStartRow))
                    fl = StrReplace(1, fl, "#-1#", CStr(i + cntStartRow - 1))
                    fl = StrReplace(1, fl, "#-2#", CStr(i + cntStartRow - 2))
                    fl = StrReplace(1, fl, "#-3#", CStr(i + cntStartRow - 3))
                End If
                br = Int(Nz(elm.getAttribute("brweight"), 0))
                CT.range(c1).Locked = Nz(elm.getAttribute("locked"), False)
                CT.range(c1).HAlignment = Nz(elm.getAttribute("halign"), ssHAlignRight)
                CT.range(c1).VAlignment = Nz(elm.getAttribute("valign"), ssVAlignCenter)
                CT.range(c1).Interior.Color = Nz(elm.getAttribute("bgcolor"), "silver")
                CT.range(c1).Font.Color = Nz(elm.getAttribute("color"), "black")
                CT.range(c1).NumberFormat = Nz(elm.getAttribute("format"), "Text")
                If Len(c2) = 0 Then
                    If br <> 0 Then
                        CT.range(c1).Borders.Weight = br
                    End If
                    CT.range(c1).Borders.Color = Int(Nz(elm.getAttribute("brcolor"), 0))
                Else
                    c2 = elm.getAttribute("cell2") & (i + cntStartRow)
                    CT.range(c1, c2).Borders.LineStyle = 2
                    If Left(c1, 1) = Left(c2, 1) Then
                        CT.range(c1, c2).Borders(xlDiagonalDown).LineStyle = 0
                    Else
                        CT.range(c1, c2).Borders(xlDiagonalUp).LineStyle = 0
                    End If
                    If br <> 0 Then
                        CT.range(c1, c2).Borders.Weight = br
                    End If
                    CT.range(c1, c2).Borders.Color = Int(Nz(elm.getAttribute("brcolor"), 0))
                    CT.range(c1, c2).Merge
                End If
                If Len(fl) = 0 Then
                    CT.range(c1) = Nz(elm.getAttribute("caption"), "")
                Else
                    CT.range(c1).formula = "=" + fl
                End If
            End If
        Next j
    Next i


ну это все в общем случае :) в целом - придется, конечно, потрудиться


Ваше имя:

Пароль:
Цитировать: [quote][/quote] Код: [code][/code]
Жирный: [b][/b] Наклонный: [i][/i]
URL: [url][/url] 

Сообщение:

 Размер файла не более 50 Кбт. Большие файлы можно размещать на www.slil.ru

Прикрепить:

 

Для вставки смайлов в текст щелкните по значку.