Выделение несмежных диапазонов в таблице Акцента |
При выделении мышью диапазона ячеек в таблице отчёта программы Акцент происходит суммирование чисел, итоговая сумма отображается в строке состояния таблицы. Но часто возникает необходимость подсчитать сумму чисел в отдельных ячейках или несмежных диапазонах. На листе MSExcel можно выделить несмежные ячейки, воспользовавшись клавишей CTRL. В новой программе А2 также существует похожий функционал. Оказалось, подобный функционал несмежных диапазонов воможен и в Акценте. Ниже приведен текст модуля таблицы, который его обеспечивает. При этом возможно распространение этого полезного свойства на все отчёты добавлением небольшой процедуры в модуле рабочей области. Ниже представлен текст обработчика события нажатия левой кнопки мыши в таблице. Dim arSelect : arSelect=Array 'в массиве хранятся координаты КАЖДОЙ ячейки несмежного диапазона. 'потому что при сбросе выделения желательно вернуть ИСХОДНЫЙ цвет фона. Sub Sheet1_OnClick Dim r : Set r=Sheet1.Selection If CreateLibObject("WinAPI").GetKeyState(17)=True Then' 17=acControl Call AddRangeToArray(r) 'добавить выделенный диапазон в глоб.массив Call ColorAr(vbGreen) 'посчитать сумму ячеек и показать результат. Else Call RestoreBkColor 'вернуть назад исходный цвет фона. arSelect=Array 'очистить массив координат выделенных ячеек. End If End Sub Sub RestoreBkColor Dim n : For n=UBound(arSelect) To 0 Step-1 Dim ar : ar=arSelect(n) sheet1.Cell(ar(0),ar(1)).BackColor=ar(2) Next End Sub Sub AddRangeToArray(r) Dim row, col : For row=r.Top To r.Top+r.Height-1 For col=r.Left To r.Left+r.Width-1 ReDim Preserve arSelect(UBound(arSelect)+1) arSelect(UBound(arSelect))=Array(row, col, sheet1.Cell(row,col).BackColor) Next Next End Sub Sub ColorAr(bk) Dim map: Set map=CreateLibObject("Map") Dim ar : For Each ar In arSelect Dim row : row=ar(0) Dim col : col=ar(1) If Not map.Exists(row&","&col) Then map.Item(row&","&col)="посчитано" 'исключить повторный счёт Dim c : Set c=sheet1.Cell(row,col) Dim s : If IsNumeric(c.Value) Then s=s+CCur(c.Value) c.BackColor=bk End If Next ShtBook.ShowPopUp "1:Сумма = "&FormatNumber(s,2) End Sub При желании этот участок кода легко размещается в процедуре Export2ExcelViaHTML модуля рабочей области стандартной настройки ST7_WorkArea.avb |
След. » |
---|