Главная DISCLAIMER Ссылки Карта сайта Контакты
Главная arrow Вопросы разработки arrow Выделение несмежных диапазонов в таблице Акцента
Выделение несмежных диапазонов в таблице Акцента

При выделении мышью диапазона ячеек в таблице отчёта программы Акцент происходит суммирование чисел, итоговая сумма отображается в строке состояния таблицы. Но часто возникает необходимость подсчитать сумму чисел в отдельных ячейках или несмежных диапазонах. На листе MSExcel можно выделить несмежные ячейки, воспользовавшись клавишей CTRL. В новой программе А2 также существует похожий функционал.

Оказалось, подобный функционал несмежных диапазонов воможен и в Акценте. Ниже приведен текст модуля таблицы, который его обеспечивает. При этом возможно распространение этого полезного свойства на все отчёты добавлением небольшой процедуры в модуле рабочей области.

Ниже представлен текст обработчика события нажатия левой кнопки мыши в таблице.
Непосредственно перечень адресов произвольно выделенных ячеек таблицы хранится в глобальном массиве. При нажатии акселератора CTRL одновременно с выделением мышью диапазона происходит добавление координат выделенных ячеек к массиву, отметка цветом фона, подсчёт суммы числовых данных в этих ячейках и её отображение. При выделении мышью без нажатия акселератора происходит очистка массива и отмена ранее обозначенного выделения, что в целом соответствует поведению рабочего листа в программе Excel.

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

 
След. »