Независимый форум, посвященный системе БОСС-Кадровик
и всему, что с ней связано
|
|
| Предыдущая тема :: Следующая тема |
| Автор |
Сообщение |
Mikhail
Зарегистрирован: 16.08.2012
Сообщения: 177
Откуда: Москва
|
 Добавлено: Пн Авг 20, 2012 17:25 Заголовок сообщения: Макрос: копирование листа на следующий (Exсel) |
 |
|
Всем доброго дня!
Прошу помощи в написании макроса для копирования содержимого листа на другой лист в Excel.
Столкнулся с такой задачей впервые, поэтому просьба критиковать максимально развернуто 
| Код: |
let sheet_ := 1; -- № листа шаблона
--создаем таблицу для данных
$if object_id('tempdb..#aktpfr') is not null drop table tempdb..#aktpfr;
create table #aktpfr
(
ntab varchar (30) NULL,
fname varchar (150) NULL,
sname varchar (255) NULL,
scode int NULL
);
insert into #aktpfr (ntab, fname, sname, scode)
select pl.num_tab, cd.full_name, st1.struct_name, st1.struct_code
from people as pl, card as cd, z_rep_pach as rp, z_pachka as p, structs as st, structs as st1
where rp.id_pachka = p.id
and rp.auto_card = cd.auto_card
and cd.auto_card = pl.auto_card
and pl.struct_code = st.struct_code
and st.struct_root = st1.struct_code
and p.id = _pachka_ -- id пачки, на которой установлен курсор
order by 2;
--открываем шаблон
execute xocxfree{*};
Local PathTemplate;
alias PathTemplate := @@xReport(open USER_ПЕРЕДАЧА_СТРАХОВЫХ_ПФР.xlt);
if PathTemplate[''] = '' then {
Error [\3Файл Шаблон отчета USER_ПЕРЕДАЧА_СТРАХОВЫХ_ПФР.xlt не найден!];
con;
--free _mib, *;
};
Excel.Application as Excel;
Excel.Visible=True;
Excel.Workbooks.Open(PathTemplate[""]);
VB {
Dim Ex
Dim Sh
};
VB {
Set Ex = GetObject(,"Excel.Application")
Set Sh = Ex.ActiveSheet
};
vb{
Dim n1V
};
vb{
Dim n2V
};
_begin:; -- точка возвращения GO TO
--выбираем max(struct_code) магазина из текущей пачки
select max(scode)
into :max_
from #aktpfr;
--выгружаем данные из временной таблицы в шаблон
stable @x
select ntab, fname, sname
from #aktpfr
where scode = max_
order by 2;
let n := 9; -- № строки в шаблоне для начала выгрузки
scan @x
execute {
Excel.ActiveWorkbook.sheets(sheet_).cells(n, 1) = @x:1[''];
Excel.ActiveWorkbook.sheets(sheet_).cells(n, 2) = @x:2[''];
Excel.ActiveWorkbook.sheets(sheet_).cells(n, 5) = @x:3[''];
let n := n + 1;
};
--рисуем рамку в Excel
let n := n-1;
Alias vb.n1V := n;
vb {
Sh.Range(Sh.Cells(9,1),Sh.Cells(n1V,5)).Select
Ex.Selection.wraptext=true
Ex.Selection.Borders(5).LineStyle = -4142
Ex.Selection.Borders(6).LineStyle = -4142
With Ex.Selection.Borders(7)
.Weight = 2
End With
With Ex.Selection.Borders(8)
.Weight = 2
End With
With Ex.Selection.Borders(9)
.Weight = 2
End With
With Ex.Selection.Borders(10)
.Weight = 2
End With
With Ex.Selection.Borders(11)
.Weight = 2
End With
With Ex.Selection.Borders(12)
.Weight = 2
End With
};
--копируем шапку отчета на следующий лист
let sheet_ := sheet_ + 1;
vb {
Sh.Range(Sh.Cells(1,1),Sh.Cells(6,5)).Select
Ex.Selection.Copy
Ex.ActiveWorkbook.sheets(sheet_).Select
Ex.ActiveSheet.Paste
};
delete #aktpfr where scode = max_;
if exists (select scode from #aktpfr)
then {goto _begin};
CON Открытие Excel ...;
con;
execute xOcxFree(*); -- Закрыть программу EXCEL
--set Excel = Nothing;
ALIAS :_Result=-1; free mif, *;
|
При выполнении происходит заполнение первого листа данными из #akfpfr, выделение и копирование шапки (проврил ctrl+v), но дальше этого дело не идет, прерывается ошибкой.
Пока, конкретных предположений на счет источника ошибки у меня нет, поэтому хотелось бы с вашей помощью разобраться |
|
| Вернуться к началу |
|
 |
Mikhail
Зарегистрирован: 16.08.2012
Сообщения: 177
Откуда: Москва
|
| Добавлено: Пт Авг 24, 2012 17:06 Заголовок сообщения: |
|
|
| Эх.. ну что, все в отпусках? |
|
| Вернуться к началу |
|
|
zhenya17
Зарегистрирован: 04.02.2009
Сообщения: 190
Откуда: Кемерово
|
| Добавлено: Сб Сен 01, 2012 21:56 Заголовок сообщения: |
|
|
После копирования шапки у Вас написано | Цитата: | | delete #aktpfr where scode = max_ |
, попробуйте всё-таки delete FROM #aktpfr where scode = max_.
Или что за ошибка выдаётся?[/code] |
|
| Вернуться к началу |
|
|
Mikhail
Зарегистрирован: 16.08.2012
Сообщения: 177
Откуда: Москва
|
| Добавлено: Пн Сен 03, 2012 11:53 Заголовок сообщения: |
|
|
zhenya17, привет!
Каюсь, что не описал подробнее ошибку и ввел в заблуждение.
Ошибка следующая:
| Код: |
Source:'Microsoft VBScript compilation error'
File:" Line:4 Char:1
Error:0 'Expected statement'
-- Ex.sheets(sheet_).activate
|
Если включить в цикл блок отвечающий за открытие шаблона, то весь отчет работает исправно и корректно выгружает данные, но при этом открывается не один, а несколько отдальных файлов. А хотелось бы попробовать все поместить в один, но на разных листах. |
|
| Вернуться к началу |
|
|
zhenya17
Зарегистрирован: 04.02.2009
Сообщения: 190
Откуда: Кемерово
|
| Добавлено: Ср Сен 05, 2012 22:33 Заголовок сообщения: |
|
|
Попробуйте вместо | Цитата: | | Ex.ActiveWorkbook.sheets(sheet_).Select |
написать | Цитата: | | Ex.sheets(sheet_).Select |
Также в качестве эксперимента можно попробовать заменить sheet_ на номер листа, т.е. | Цитата: | | Ex.sheets(2).Select |
В общем поэкспериментируйте, а то навскидку ошибка не очевидна. Удачи! |
|
| Вернуться к началу |
|
|
Mikhail
Зарегистрирован: 16.08.2012
Сообщения: 177
Откуда: Москва
|
| Добавлено: Чт Сен 06, 2012 14:48 Заголовок сообщения: |
|
|
Спасибо, пробовал разные варианты прежде чем писать сюда
Сейчас задача немного изменилась: вместе с копированием необходимо использовать процедуру создания нового листа, т.к. имеющихся 3-х по умолчанию недостаточно. |
|
| Вернуться к началу |
|
|
zhenya17
Зарегистрирован: 04.02.2009
Сообщения: 190
Откуда: Кемерово
|
| Добавлено: Пт Сен 14, 2012 10:25 Заголовок сообщения: |
|
|
| Mikhail писал(а): | Спасибо, пробовал разные варианты прежде чем писать сюда
Сейчас задача немного изменилась: вместе с копированием необходимо использовать процедуру создания нового листа, т.к. имеющихся 3-х по умолчанию недостаточно. |
Так, и что теперь останавливает?
Ниже пример добавления листа...
| Код: | Excel.Application as Excel;
Excel.Visible = True;
Excel.Workbooks.Add();
local vb.Excel==&Excel; -- передача в VBScript
vb{
if Excel.Sheets.Count < 2 then
Excel.Sheets.Add()
end if
Excel.Sheets(1).Select
Excel.Sheets(1).Name = "После 1967г.р."
With Excel.ActiveSheet.PageSetup
.Orientation = 2
.LeftMargin = Excel.InchesToPoints(0.275590551181102)
.RightMargin = Excel.InchesToPoints(0.275590551181102)
.TopMargin = Excel.InchesToPoints(0.393700787401575)
.BottomMargin = Excel.InchesToPoints(0.393700787401575)
.HeaderMargin = Excel.InchesToPoints(0)
.FooterMargin = Excel.InchesToPoints(0)
.Zoom = 90
End With
};
Let Row = 1;
Excel.Cells(Row,1).Value = 'Таб. №';
Excel.Columns(1).ColumnWidth = 8;
Excel.Cells(Row,2).Value = 'Фамилия Имя Отчество';
Excel.Columns(2).ColumnWidth = 50;
Excel.Cells(Row,3).Value = 'Месяц';
Excel.Columns(3).ColumnWidth = 8;
Excel.Cells(Row,4).Value = 'Дата рождения';
Excel.Columns(4).ColumnWidth = 10;
Excel.Cells(Row,5).Value = 'Выплаты ВСЕГО';
Excel.Columns(5).NumberFormat = '#,##0.00';
Excel.Columns(5).ColumnWidth = 15;
...
|
|
|
| Вернуться к началу |
|
|
|
|
Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете голосовать в опросах
|
|
FAQ
Поиск
Пользователи
Группы
Регистрация
Профиль
Войти и проверить личные сообщения
Вход
