Список форумов BOSSForum.RU - Форум. БОСС-Кадровик
Независимый форум, посвященный системе БОСС-Кадровик
и всему, что с ней связано
 FAQFAQ   ПоискПоиск   ПользователиПользователи   ГруппыГруппы   РегистрацияРегистрация 
 ПрофильПрофиль   Войти и проверить личные сообщенияВойти и проверить личные сообщения   ВходВход 

Условное форматирование при использовании QueryTable(решил)

 
Начать новую тему   Ответить на тему    Список форумов BOSSForum.RU - Форум. БОСС-Кадровик -> X-язык
Предыдущая тема :: Следующая тема  
Автор Сообщение
Константин



Зарегистрирован: 02.05.2012
Сообщения: 39
Откуда: Красноярск

СообщениеДобавлено: Пн Апр 01, 2013 10:55    Заголовок сообщения: Условное форматирование при использовании QueryTable(решил) Ответить с цитатой

Пытаюсь прикрутить к отчету на QueryTable условное форматирование.

Предположим, что надо сделать отчет со списком сотрудников и что бы каждая запись с сотрудником чередовалась по цвету. В случае, если отчет выводится через Querytable то получается быстро, но с форматированием немного сложней, тем более с применением цветов к разным записям в зависимости от условия.

Уже приводил данный код на этом формуле, поэтому продолжу на нем же.

Если в Excele создать нужное условное форматирование и сохранить макрос, то получится так:
Код:
    Selection.FormatConditions.Delete
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$A1=1"
    Selection.FormatConditions(1).Interior.ColorIndex = 36
    Selection.AutoFill Destination:=Range("B1:D8"), Type:=xlFillDefault
    Range("B1:D8").Select


Переписываем в код босс-кадровика, в теории должна работать.
Но на строке
Код:
FormatConditions.Add Type:=xlExpression, Formula1:="=$A1=1"

Вываливается ошибка.




Пока не заменил константы Excel на значения, это успеется после решения по устранению ошибки.
Вот пример всего кода:

Код:

--Подготовим тестовые данные
     erroroff;
     DROP TABLE tmp_20120412_1;
     DROP TABLE tmp_20120412_2;
     erroron;

     create table tmp_20120412_1 (str_code int, str_name nvarchar(50));
     create table tmp_20120412_2 (id int, fio_name nvarchar(50), str_code int);

     insert into tmp_20120412_1 (str_code,str_name) VALUES ('1','Дирекция');
     insert into tmp_20120412_1 (str_code,str_name) VALUES ('2','Инженеры');
     insert into tmp_20120412_1 (str_code,str_name) VALUES ('3','Рабочие');

     insert into tmp_20120412_2 (id,fio_name,str_code) VALUES ('1','Вася А','1');
     insert into tmp_20120412_2 (id,fio_name,str_code) VALUES ('2','Вася Б','1');
     insert into tmp_20120412_2 (id,fio_name,str_code) VALUES ('3','Петя А','2');
     insert into tmp_20120412_2 (id,fio_name,str_code) VALUES ('4','Петя Б','2');
     insert into tmp_20120412_2 (id,fio_name,str_code) VALUES ('5','Миша А','3');
     insert into tmp_20120412_2 (id,fio_name,str_code) VALUES ('6','Миша Б','3');
     insert into tmp_20120412_2 (id,fio_name,str_code) VALUES ('7','Жора А','3');
     insert into tmp_20120412_2 (id,fio_name,str_code) VALUES ('8','Жора Б','3');
     insert into tmp_20120412_2 (id,fio_name,str_code) VALUES ('9','Боря А','3');
     insert into tmp_20120412_2 (id,fio_name,str_code) VALUES ('10','Боря Б','3');


-- Параметры коннекта
     Free _dsn,_db,_uid,_pwd,_is_ntuser,_ConnStr;
     Local {_dsn;_db;_uid;_pwd;_is_ntuser;_ConnStr;};

     Let _dsn = '@@xUtil{DSN}';
     select db_name() into :_db;
     select suser_sname() into :_uid;
     Let _Pwd = '@@xUtil{pwd}';
     select Count(*) into :_is_ntuser from master.dbo.syslogins where loginname = suser_sname() and (isntname =1 OR isntgroup = 1 OR isntuser = 1);
     if _is_ntuser['] > 0
     then {Let _ConnStr := 'ODBC;DSN=' + _dsn[''] + ';UID=' + _uid[''] + ';PWD=;Database=' + _db[''];}
     else {Let _ConnStr := 'ODBC;DSN=' + _dsn[''] + ';UID=' + _uid[''] + '; PWD=' + _pwd[''] + ';Database=' + _db['']};
     Free _dsn,_db,_uid,_pwd,_is_ntuser;


-- Начало вывода результата в Excel
     VB.FREE;
     VB{
          Dim ConnStr
          Dim str_query
          Dim Flag
     };

     Let VB.ConnStr := _ConnStr[""];
     Alias VB.Flag == 0;

     VB {
          Flag = 0

          Dim cc
          Dim lc
          Dim Excel
          Dim Sh
          Dim CurPosY
          Dim SeekY
          Dim st_name

          Err.Clear
          On Error Resume Next
          Set Excel = GetObject(,"Excel.Application")

          If Err.Number <> 0 Then
               Err.Clear
               Set Excel = CreateObject("Excel.Application")
          end if
          On Error Goto 0

   
          Excel.Visible = True
          rem Excel.Workbooks.Add
          Set Sh = GetObject("", "Excel.sheet")
          Set Sh = Sh.sheets(1)
          Sh.PageSetup.Orientation = 2
          rem Sh.PageSetup.Zoom = False
          rem Sh.PageSetup.FitToPagesWide = 1
          rem Sh.PageSetup.FitToPagesTall = 1
          Excel.ActiveWindow.WindowState = -4137 ' на весь жкран развернуть
     };


     stable @structs select str_code,str_name from tmp_20120412_1;
   
     let vb.CurPosY=1; --Положение курсора в таблице
     let vb.SeekY=0;  -- Кол-во записей возвращаемых запросом

     --Перебираем структуру предприятия
     scan @structs
     execute {
          alias astr_query = select ROW_NUMBER() OVER(ORDER BY id),fio_name,str_code from tmp_20120412_2 where str_code=@structs:1; -- запрос получения списка сотрудников в подразделении
          let vb.str_query := astr_query[""]; --передаем параметр в объект VB
          let vb.st_name := @structs:2;  -- передаем в VB наименвоание подразделения

          --для смещения вниз необходимо знать кол-во записей в запросе
          stable @lenquery astr_query;
          let vb.seeky := @lenquery:[x];
          destroy @lenquery;
         
          --добавляем в таблицу точки вывода запроса, сами запросы
          VB {
               'добавляем некое подобие шапки, прежде объединив их
               sh.Range(sh.Cells(CurPosY,1), sh.Cells(CurPosY,3)).MergeCells = True         
               sh.Cells(CurPosY,1) = st_name
               CurPosY = CurPosY + 1

               With Sh.QueryTables.Add(ConnStr, Sh.Range(sh.cells(CurPosY,1),sh.cells(CurPosY+seeky,3)))
               .Name = "ExportData"
               .CommandText = str_query
               .FieldNames = false 'не выводить наименовая полей
               .RefreshStyle = 0 'не смещать данные при добавлении в область ранее добавленных данных, если 1 то будет смещать
               .Refresh
               End With
         'Условное форматирование

   
    Sh.Range(sh.cells(CurPosY,1),sh.cells(CurPosY+seeky,3)).FormatConditions.Delete
    Sh.Range(sh.cells(CurPosY,1),sh.cells(CurPosY+seeky,3)).FormatConditions.Add Type:=xlExpression, Formula1:="=($A2/2)=IE?OAE($A2/2;0)"
    Sh.Range(sh.cells(CurPosY,1),sh.cells(CurPosY+seeky,3)).FormatConditions(1).Interior.ColorIndex = 36
    Sh.Range(sh.cells(CurPosY,1),sh.cells(CurPosY+seeky,3)).AutoFill Destination:=Range("A2:B3"), Type:=xlFillDefault


               CurPosY = CurPosY + seeky 'сдвигаем курсор таблицы на размер добавляемых данных
         
          };
     };
     destroy @structs;

     VB {
          flag=1
          set Excel = nothing
   
     };--VB

     VB.FREE;


Может кто подскажет как устранить ошибку, в контексте Босс-Кадровика.
_________________
return @@tMonth[%m]


Последний раз редактировалось: Константин (Пн Апр 01, 2013 12:14), всего редактировалось 1 раз
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Посетить сайт автора
Константин



Зарегистрирован: 02.05.2012
Сообщения: 39
Откуда: Красноярск

СообщениеДобавлено: Пн Апр 01, 2013 12:12    Заголовок сообщения: Ответить с цитатой

Уже в который раз: стоит только создать тему тут и решение сразу же находится. А так я два дня уже ломал голову, КАК вставить условное форматирование.

В общем решение простое, как всегда:
Код:

VB {
With Sh.Range("$A1:$C13").FormatConditions.Add(2,0, "=($A1/2)<>ОКРУГЛ($A1/2;0)")
    With .Interior
      .ColorIndex = 36
    End With

End With
};


Кто понимает, тот разберется куда вставить этот кусок.
_________________
return @@tMonth[%m]
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Посетить сайт автора
Показать сообщения:   
Начать новую тему   Ответить на тему    Список форумов BOSSForum.RU - Форум. БОСС-Кадровик -> X-язык Часовой пояс: GMT + 4
Страница 1 из 1

 
Перейти:  
Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете голосовать в опросах


Pоwerеd by рhpВB © 2001, 2005 рhpВB Grouр
Русская поддержка phрВB
Rambler's Top100 Рейтинг@Mail.ru Список форумов BOSSForum.RU