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

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



Зарегистрирован: 02.05.2012
Сообщения: 39
Откуда: Красноярск
СообщениеДобавлено: Сб Май 12, 2012 09:23    Заголовок сообщения: Ответить с цитатой
rebel25
Ваш пример оказался более производительный чем второй, только после выполнения в памяти остается процесс EXCEL, даже если закрыть сформированный документ. Не могу понять какую переменную надо убить по завершению формирования отчета.

немного модифицировал код:
Код:


--Быстрый вывод в Excel двух запросов, в каждом по 126000 записей


Local {_strQry; _Title; _Title1;};


Select short_name
into :Struct_name_
from setup where id_firm = 1;

Let {
_Title = 'asdqwe123';
};


Let {
_Title1 = Struct_name_[''] + ' Период:' +'_dateask_month[м]' + ' _dateask_year';
};

Alias _strQry := select
"Подразделение" = FNAme
,"ПФ(страх)" = h1
,"ПФ(накоп)" = h2
,"ПФ(всего)" = h4
,"ФСС" = h5
,"ТФОМС" = h6
,"ФФОМС" = h7
,"Травматизм" = h8
,"НДФЛ" = st
from user_rep
;

-- Параметры коннекта
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;



-- Выгрузка данных
VB.FREE;
VB{
Dim ConnStr
Dim strQry
Dim TitleTxt
Dim TitleTxt1

Dim Flag
};

Let VB.ConnStr := _ConnStr[""];
Let VB.strQry := _strQry[""];
Let VB.TitleTxt := _Title[""];
Let VB.TitleTxt1 := _Title1[""];

Alias VB.Flag == 0;


VB {
Flag = 0

Dim cc
Dim lc
Dim Excel
Dim Sh

   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
Sh.PageSetup.Zoom = False
Sh.PageSetup.FitToPagesWide = 1
Sh.PageSetup.FitToPagesTall = 1


With Sh.QueryTables.Add(ConnStr, Sh.Range("A3"))
.Name = "ExportData"
.CommandText = strQry
.FieldNames = True
rem .RowNumbers = false
rem .FillAdjacentFormulas = False
rem .PreserveFormatting = True
rem .RefreshOnFileOpen = False
rem .BackgroundQuery = False
rem .RefreshStyle = 1
rem .SavePassword = False
rem .SaveData = True
rem .AdjustColumnWidth = True
rem .RefreshPeriod = 0
rem .EnableEditing = False
rem .PreserveColumnInfo = True
.Refresh
End With

With Sh.QueryTables.Add(ConnStr, Sh.Range("L3"))
.Name = "ExportData"
.CommandText = strQry
.FieldNames = True
rem .RowNumbers = false
rem .FillAdjacentFormulas = False
rem .PreserveFormatting = True
rem .RefreshOnFileOpen = False
rem .BackgroundQuery = False
rem .RefreshStyle = 1
rem .SavePassword = False
rem .SaveData = True
rem .AdjustColumnWidth = True
rem .RefreshPeriod = 0
rem .EnableEditing = False
rem .PreserveColumnInfo = True
.Refresh
End With


cc = Sh.UsedRange.Columns.Count
While cc = 0
cc = Sh.UsedRange.Columns.Count
wend

if Sh.UsedRange.Rows.Count > 1 then
Sh.UsedRange.Select
Excel.Selection.Borders(5).LineStyle = -4142
Excel.Selection.Borders(6).LineStyle = -4142
With Excel.Selection.Borders(7)
.LineStyle = 1
.Weight = 2
.ColorIndex = -4105
End With
With Excel.Selection.Borders(8)
.LineStyle = 1
.Weight = 2
.ColorIndex = -4105
End With
With Excel.Selection.Borders(9)
.LineStyle = 1
.Weight = 2
.ColorIndex = -4105
End With
With Excel.Selection.Borders(10)
.LineStyle = 1
.Weight = 2
.ColorIndex = -4105
End With
With Excel.Selection.Borders(11)
.LineStyle = 1
.Weight = 2
.ColorIndex = -4105
End With
With Excel.Selection.Borders(12)
.LineStyle = 1
.Weight = 2
.ColorIndex = -4105
End With
End If 'if Sh.UsedRange.Rows.Count
cc = Sh.UsedRange.Columns.Count

Sh.Range(Sh.Cells(3, 1), Sh.Cells(3, cc)).Select
With Excel.Selection.Interior
.ColorIndex = 15
.Pattern = 1
End With
With Excel.Selection
.HorizontalAlignment = -4108
.VerticalAlignment = -4160
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With

Excel.Selection.WrapText = True
Excel.Selection.ColumnWidth = 10
Excel.Columns("A:A").ColumnWidth = 40
Excel.Columns("B:B").ColumnWidth = 14
Excel.Columns("C:C").ColumnWidth = 14
Excel.Columns("D:D").ColumnWidth = 14
Excel.Columns("E:G").ColumnWidth = 14
Excel.Columns("H:H").ColumnWidth = 14
Excel.Columns("I:I").ColumnWidth = 14
Excel.Columns("E:H").WrapText = True
Excel.Columns("A:H").VerticalAlignment = -4160


Sh.Range("A1").Value = TitleTxt
Sh.Range("A1").Select
Sh.Range(Sh.Cells(1, 1), Sh.Cells(1, cc)).Select

Excel.Selection.Font.Bold = True
Excel.Selection.Font.Size = Excel.Selection.Font.Size

Sh.Range("A2").Value = TitleTxt1
Sh.Range("A2").Select
Excel.Selection.Font.Bold = True
Excel.Selection.Font.Size = Excel.Selection.Font.Size

Sh.Range(Sh.Cells(4, 3), Sh.Cells(99, 9)).Select

Excel.Selection.NumberFormat = "#,##0.00"

Sh.Range("A2").Select


Flag = 1
};--VB

VB.FREE;
free *;
EndFn:
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Посетить сайт автора
Константин



Зарегистрирован: 02.05.2012
Сообщения: 39
Откуда: Красноярск
СообщениеДобавлено: Сб Май 12, 2012 10:15    Заголовок сообщения: Ответить с цитатой
Разобрался с висящим Excel:
Надо добавить:
Код:
set Excel = Nothing
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Посетить сайт автора
hi-story



Зарегистрирован: 18.09.2017
Сообщения: 5
СообщениеДобавлено: Вт Окт 24, 2017 11:51    Заголовок сообщения: Ответить с цитатой
Добрый день,

А кто-нибудь может подсказать, как заполнить несколько листов в Excel? 2 листа у меня заполняет, а если сделать больше, то выдает ошибку

Код:


--Запуск приложения


free Excel;
vb.free;

let debug_ = 0;


local SqlText1 as string;
local SqlText2 as string;
local SqlText3 as string;
local SqlText5 as string;
ADODB.Connection as AutoCon;
ADODB.Recordset as AutoSet;
AutoCon.Open('@@xUtil{dsq}');
AutoSet.CursorLocation = 2;

--Подгружаем шаблон
Local PathTemplate;
alias PathTemplate := @@xReport(open user_HrReq_emps.xls);
if PathTemplate[''] = '' then {
 Error [\3user_HrReq_emps.xls не найден !!!];
};

local vb.pathtemplate as string;
alias vb.pathtemplate=PathTemplate[""];

-- Загрузка в файл



execute xOCX
{
   Excel.Application as Excel;
};

execute xOCX
{
   Excel.Visible=0;
};

delete from user_hrreq_emps where st = curstation;

exec [user_prc_hrreq_emps] curstation;


let SqlText1=
'
Select *

from user_hrreq_emps
where st=curstation
order by Company, 3, w_code
';


if debug_ == 1 then MSG [SQLTExt1];
CON 10;


let SqlText2=
'
Select *
from user_hrreq_struct
where st=curstation
';

if debug_ == 1 then MSG [SQLTExt2];
CON 10;

let SqlText3=
'
select code
from user_hrreq_ntc
where st=curstation
order by code
';

if debug_ == 1 then MSG [SQLTExt4];
CON 10;


let SqlText5=
'
Select
parent,
child
from user_hrreq_depart
where st=curstation
';

if debug_ == 1 then MSG [SQLTExt5];
CON 10;



AutoSet.Open(:SqlText1, :AutoCon, 3, 1, 1);

if debug_ == 1 then MSG [1];


local vb.objRec=&AutoSet;
--------
local vb.objXL=&Excel;
local vb.pathtemplate as string;

if debug_ == 1 then MSG [2];



alias vb.pathtemplate=PathTemplate[""];

vb
{ 
   objXL.ScreenUpdating = 1
   objXL.EnableEvents = 1
   Dim objWkBook

   Set objWkBook=objXL.Workbooks.Add(pathtemplate)
};

if debug_ == 1 then MSG [3];

CON 20;
Excel.Application.Interactive = 0;  --False (чтобы пользователь не вмешивался)    
---






---адрес для вставки результата запроса
vb{
   objWkBook.Worksheets(1).Cells(2,1).CopyFromRecordset objRec
};
if debug_ == 1 then MSG [4];

AutoSet.Close;


if debug_ == 1 then MSG [5];

CON 30;

AutoSet.Open(:SqlText2, :AutoCon, 3, 1, 1);

if debug_ == 1 then MSG [1];

local vb.objRec=&AutoSet;
--------
local vb.objXL=&Excel;
local vb.pathtemplate as string;

vb{
   objWkBook.Worksheets(2).Cells(2,1).CopyFromRecordset objRec
};
if debug_ == 1 then MSG

AutoSet.Close;

if debug_ == 1 then MSG [5];

CON 30;










Excel.Application.Interactive = 1; /* True*/


execute xOCX
{
   Excel.Visible=True;
};

--Уничтожение объекта
execute xOcxFree(Excel);
execute xOcxFree(AutoSet);
execute xOcxFree(AutoCon);

CON;
delete user_hrreq_emps where st=curstation;
delete user_hrreq_struct where st=curstation;
delete user_hrreq_ntc where st=curstation;
delete user_hrreq_depart    where st=curstation;




Так вот, если оставить только две подстановки (на любые листы), то все работает. А так ошибка EXCEPTION: ADODB.Recordset:Operation is not Allowed when the object is open

Что я делаю не так?
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
tveritin



Зарегистрирован: 26.01.2016
Сообщения: 191
Откуда: Санкт-Петербург
СообщениеДобавлено: Чт Фев 09, 2023 13:04    Заголовок сообщения: Ответить с цитатой
Kauffman писал(а):
Мне нравится следующий пример.
Можно использовать готовый шаблон для выгрузки.

Цитата:
local Query_ as string;

ADODB.Connection as AutoCon;
ADODB.Recordset as AutoSet;
ADODB.Recordset as AutoSet2;
AutoCon.Open('@@xUtil{dsq}');
AutoSet.CursorLocation = 2;



Да в экселе это прекрасно работает.
Есть ли у кого опыт заполнения таблиц в winword ?
Вариант поячеечного заполнения таблицы, когда строк очень много, очень затратный по времени. Существует ли аналог этого метода, применимый для Word ?
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail
superjek



Зарегистрирован: 04.04.2022
Сообщения: 29
СообщениеДобавлено: Чт Фев 09, 2023 15:25    Заголовок сообщения: Ответить с цитатой
Для быстрой вставки таблицы нагуглил пару вариантов:
1) Преобразовать текст в таблицу. Выгружаем в Word текст разделенный разделителями. Потом макросом выделяем этот текст и преобразовываем в таблицу методом:
Код:
 
Selection.ConvertToTable Separator:="#", _
        NumColumns:=2, NumRows:=4, AutoFitBehavior:=wdAutoFitFixed


2) Сгенерить сначала таблицу на html, сохранить в файл, а потом его вставить в нужное место Word
Код:

Selection.InsertFile FileName:="1.html", Range:="", ConfirmConversions:= _
        False, Link:=False, Attachment:=False
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
tveritin



Зарегистрирован: 26.01.2016
Сообщения: 191
Откуда: Санкт-Петербург
СообщениеДобавлено: Чт Фев 09, 2023 17:42    Заголовок сообщения: Ответить с цитатой
Спасибо, в общем неплохой метод преобразования текста в таблицу.
А потом, чтоб не форматировать таблицу заново (поскольку красивая таблица уже есть в шаблоне), можно сделать
Selection.PasteAndFormat (wdTableOverwriteCells)
или что-то вроде этого.
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail
tveritin



Зарегистрирован: 26.01.2016
Сообщения: 191
Откуда: Санкт-Петербург
СообщениеДобавлено: Пт Фев 10, 2023 16:47    Заголовок сообщения: Ответить с цитатой
Неа, всё же не нравится мне такой метод.
Хочется сразу всё поместить в таблицу.
Можно, конечно, переписать всё в Excel, но всё же решил изучить возможности VBA Word.
Стал копать дальше по поводу соединения с MSSQL.
Код:
Dim conn As New ADODB.Connection
conn.Open "DRIVER={SQL Server};Server=server;Database=test;Trusted_Connection=yes;"
Dim rst  As New ADODB.Recordset
rst.ActiveConnection = conn
rst.Open Source:="select * from adtb_acc_group"
MsgBox rst.GetString

Это всё работает не из коробки, надо включить в VBA меню "Tools - References" Microsoft ActiveX Data objects 2.8 lib".
К базе подсоединился, даже данные вытянул. Но пока не понимаю как данные поместить/привязать одной транзакцией к ActiveDocument.Tables(n).
Описаны методы обращения к полям запроса с перебором по записям. Тогда смысл затеи полностью теряется, т.к. уже есть готовая медленноработающая X-процедура. Цель была - именно ускорить формирование справки в word.
Если всё же удастся найти метод, тогда сюда выложу как моментально заполнять таблицу данными из запроса.
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail
tveritin



Зарегистрирован: 26.01.2016
Сообщения: 191
Откуда: Санкт-Петербург
СообщениеДобавлено: Пн Фев 13, 2023 17:19    Заголовок сообщения: Ответить с цитатой
Делаю так:
Код:
SQL1 = "select string_agg(CONVERT(NVARCHAR(max),graf_1)+'#'+graf_2+'#'+graf_3+'#'+graf_4+'#'+graf_5+'#'+graf_6+'#'+graf_7+'#'+graf_8+'#'+graf_9+'#'+graf_10,'$$') as val from ( " & _
.....
rst.Open Source:=SQL1

Selection.GoTo What:=wdGoToBookmark, Name:="SQL"
Selection.TypeText rst![Val]

Но, строка обрубается где-то на середине. Ошибок при выполнении запроса нет.
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail
superjek



Зарегистрирован: 04.04.2022
Сообщения: 29
СообщениеДобавлено: Вт Фев 14, 2023 10:02    Заголовок сообщения: Ответить с цитатой
TypeText обрезает текст, попробуйте так:

Код:

Selection.Text = rst![Val]
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
tveritin



Зарегистрирован: 26.01.2016
Сообщения: 191
Откуда: Санкт-Петербург
СообщениеДобавлено: Вт Фев 14, 2023 11:11    Заголовок сообщения: Ответить с цитатой
Спасибо.
Код:
SQL1 = "select string_agg(CONVERT(NVARCHAR(max),graf_1)+'#'+graf_2+'#'+graf_3+'#'+graf_4+'#'+graf_5+'#'+graf_6+'#'+graf_7+'#'+graf_8+'#'+graf_9+'#'+graf_10,'#') as val from ( " & _
.....
rst.Open Source:=SQL1

Selection.GoTo What:=wdGoToBookmark, Name:="SQL"
Selection.Text = rst![Val]

Теперь текст полностью вставляется в документ и остается выделенным. Далее, я его пытаюсь преобразовать в таблицу
Код:
Selection.ConvertToTable Separator:="#", NumColumns:=10, AutoFitBehavior:=wdAutoFitFixed

Первые сотни строк смотрятся в виде таблицы прекрасно. Пока в значении любого поля (в данном случае 8го) не попался перенос строки.
Часть значения переносится на следующую строку с первой колонки.
И таблица поплыла.
Почему? Ведь Separator:="#". Зачем в качестве разделителя используется еще и перенос?
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail
superjek



Зарегистрирован: 04.04.2022
Сообщения: 29
СообщениеДобавлено: Ср Фев 15, 2023 10:04    Заголовок сообщения: Ответить с цитатой
Как пишут по ссылке:
по ссылке

Цитата:
If some cells in your table need to contain more than one paragraph (or to contain manual line breaks), separate those “paragraphs” or “lines”, initially, with a dummy delimiter such as a comma or a dollar sign; and then do a Find and Replace at the end (after converting the text to a table), to replace the delimiter with a paragraph mark or manual line break, as desired.


заменяем в тексте переносы строк на новый разделитель, например $
Selection.Text = Replace(Replace(rst![Val],chr(10),"$"),chr(13),"$")
Потом Selection.ConvertToTable
И наконец через поиск и замену меняем $ на переносы строк
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
tveritin



Зарегистрирован: 26.01.2016
Сообщения: 191
Откуда: Санкт-Петербург
СообщениеДобавлено: Пт Фев 17, 2023 15:17    Заголовок сообщения: Ответить с цитатой
Спасибо, но в итоге сделал в экселе через Sheets.QueryTables.
Smile
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail
Показать сообщения:   
Начать новую тему   Ответить на тему    Список форумов BOSSForum.RU - Форум. БОСС-Кадровик -> X-язык Часовой пояс: GMT + 4
На страницу Пред.  1, 2
Страница 2 из 2

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


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