Галактика в вопросах и ответах

Код: Выделить всё

interface _gt_otgruz 'Отчёт отгрузок по фирмам' escclose;
show at(,,36,3);

table struct tOtgr
(
polnrec:comp,
grpolnrec:comp,
sposob:string,
summa:double,
sf:string
)
with index
(idx1=polnrec+grpolnrec+sposob);


create view 
var
date1:date
date2:date
dat1:date
dat2:date
as select * 
from 
basedoc //фюъєьхэЄ юёэютрэш 
,ttndoc //Ёрё°шЁхэш  фюъєьхэЄют фы  ╥╥═
,tOtgr
,katorg orgPol  //╩юэЄЁрухэЄ√
,katorg orgGrPol
,katcity         //ърЄрыюу уюЁюфют
where 
((
word(1102)/==ttndoc.wtable     //уфх ёыютю Ёртэю  ╩юфє ЄрсышЎ√ ёыютрЁ 
and dat1<<=ttndoc.dpunrbeg(noindex)//dat1<<=фрЄр эрўрыр ЁрчуЁєчъш
and dat2>>=ttndoc.dpunrbeg(noindex) //dat2>>=фрЄр эрўрыр ЁрчуЁєчъш
and ttndoc.cdoc==basedoc.nrec //ёё√ыър эр тырфхы№Ўр

and tOtgr.polnrec==orgPol.nrec  //=
and tOtgr.Grpolnrec==orgGrPol.nrec
and orgGrPol.ccity==katcity.nrec
))
;

screen params 
show at(,,35,2);
fields date1:,noprotect;
fields date2:,noprotect;
buttons 
cmOK, default;
cmCancel;
<<
 c .@@@@@@@@@@  по .@@@@@@@@@@
 <.Формировать.>  <.  Закрыть  .>
>>
end;

Form otgruz ('out\otgruz.out');
Form reestr ('out\reestr.out');


handleevent 

cmInit:
{
date1:=date(1,month(cur_date),year(cur_date));   
date2:=Cur_Date;                 
}


cmOk:
{
dat1:=date1;
dat2:=date2;
var summ:double;
delete all tOtgr;
StartNewVisual(vtRotateVisual, vfTimer+vfBreak+vfConfirm,'Идет расчет реальных отгрузок...', RecordsInTable(#basedoc));

//_loop ttndoc message(basedoc.nodoc);
//_loop ttndoc message(ttndoc.dpunrend);

_loop ttndoc    
		{
		if (basedoc.vhodnal=1) then { summ:=basedoc.summa; }
			else  summ:=basedoc.summa + basedoc.nds;

		if GetFirst tOtgr where ((basedoc.corg==tOtgr.polnrec and basedoc.cgrpol==tOtgr.grpolnrec and ttndoc.splist==tOtgr.sposob))<>tsOk
		then 
		{
		insert in tOtgr set 	tOtgr.polnrec:=basedoc.corg,
					tOtgr.grpolnrec:=basedoc.cgrpol,
					tOtgr.sposob:=ttndoc.splist,
					tOtgr.summa:=summ,
					tOtgr.sf:=ltrim(trim(basedoc.nodoc),'0');
		}
		else update current tOtgr set tOtgr.summa:=tOtgr.summa+summ,
					      tOtgr.sf:=trim(tOtgr.sf)+','+ltrim(trim(basedoc.nodoc),'0');
		}

var itog:double;
var i:integer;
itog:=0;
i:=1;
_loop tOtgr 
{
//if katcity.name<>'Новосибирск' and katcity.name<>'Кольцово' then
if katcity.name<>'Кольцово' then
	{
	otgruz.puteventbyid(feDoLoop, fcOTGR1) ;
	otgruz.write(i);
	if length (trim(tOtgr.sf))>8 
	then    {
		otgruz.write('Реестр '+string(i));
		reestr.puteventbyid(feDoLoop, fcREESTR1) ;
		reestr.write(string(i));
		reestr.write(tOtgr.sf);
		}
	else	otgruz.write(tOtgr.sf);
	otgruz.write(orgPol.name);
	otgruz.write(orgGrPol.name);
	otgruz.write(datetostr(date1,'Month YYг.'));
	otgruz.write(katcity.name);
	case trim(tOtgr.sposob) of
	 '1': otgruz.write('Авиаперевозка');
	 '2': otgruz.write('Железная дорога');
	 '3': otgruz.write('Автоперевозка');
	 '4': otgruz.write('Почта');
	 else otgruz.write('Не определен');
	end;
	otgruz.write(tOtgr.summa);
	itog:=itog+tOtgr.summa;
	i:=i+1;
	}
}
otgruz.write(itog);
otgruz.puteventbyid(feBreak, fcOTGR1) ;
reestr.puteventbyid(feBreak, fcREESTR1) ;

StopVisual('Опрерации завершена!',0);
otgruz.Showfile;
reestr.Showfile;
}

end;

end.

Код: Выделить всё

Attribute VB_Name = "Module1"
Sub Landscope()
Attribute Landscope.VB_ProcData.VB_Invoke_Func = " \n14"
'
' Landscope Макрос
'

'
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.78740157480315)
        .RightMargin = Application.InchesToPoints(0.393700787401575)
        .TopMargin = Application.InchesToPoints(0.393700787401575)
        .BottomMargin = Application.InchesToPoints(0.393700787401575)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 32767
    End With
End Sub

Код: Выделить всё

Sub Auto_Open()
  If ActiveWorkbook.FullName = "<<тра-ля-ля>>\*.slk" Then
     'тут чего-то делаем
  End If
End Sub

Код: Выделить всё

Создание макроса «Авто_открыть»
Если вкладка Разработчик недоступна, выполните следующие действия для ее отображения.
Нажмите кнопку Microsoft Office , а затем щелкните Параметры Excel.
В категории Основные в группе Основные параметры работы с Excel установите флажок Показывать вкладку "Разработчик" на ленте, а затем нажмите кнопку ОК.
Для установки уровня безопасности, временно разрешающего выполнение всех макросов, выполните следующие действия:
На вкладке Разработчик в группе Код нажмите кнопку Безопасность макросов.


В категории Параметры макросов в группе Параметры макросов нажмите переключатель Включить все макросы (не рекомендуется, возможен запуск опасной программы), а затем нажмите кнопку ОК.
 ПРИМЕЧАНИЕ.   Для предотвращения запуска потенциально опасного кода по завершении работы с макросами рекомендуется вернуть параметры, отключающие все макросы.

Для сохранения макроса с конкретной книгой сначала откройте эту книгу.
На вкладке Разработчик в группе Код нажмите кнопку Запись макроса.
В поле Имя макроса введите Авто_открыть.
В списке Сохранить в выберите книгу, в которой нужно сохранить макрос.
 СОВЕТ.   Если необходимо, чтобы данный макрос был всегда доступен при работе в приложении Excel, выберите вариант Личная книга макросов. При выборе варианта Личная книга макросов создается скрытая личная книга макросов (Personal.xlsb)(если она еще не существует), в которой будет сохранен макрос. В Microsoft Windows Vista эта книга сохраняется в папке C:\Users\имя_пользователя\Application Data\Microsoft\Excel\XLStart. В Microsoft Windows XP эта книга сохраняется в папке C:\Documents and Settings\имя_пользователя\Application Data\Microsoft\Excel\XLStart. Книги из этой папки автоматически загружаются при каждом запуске приложения Excel. Если требуется автоматически запускать макрос из личной книги в другой книге, необходимо также сохранить эту книгу в папке XLStart, чтобы при запуске приложения Excel открывались обе книги.

Нажмите кнопку ОК, а затем выполните действия, которые нужно записать.
На вкладке Разработчик в группе Код нажмите кнопку Остановить запись .
 СОВЕТ.   Можно также нажать кнопку Остановить запись  слева от строки состояния.

 ПРИМЕЧАНИЯ 

Если на шаге 6 было выбрано сохранение макроса в Эта книга или Новая книга, сохраните или переместите книгу в одну из папок XLStart.
Запись макроса «Авто_открыть» имеет следующие ограничения:
Если книга, в которой сохраняется макрос "Auto_Open", уже содержит процедуру на языке VBA в событии Open, эта процедура для события Open заменит все действия макроса "Auto_Open".
При открытии книги с помощью метода Open макрос «Авто_Открыть» игнорируется.
Макрос "Auto_Open" запускается перед открытием других книг. Поэтому при записи действий, которые нужно выполнить в книге по умолчанию "Книга1" или в книге, загруженной из папки XLStart, такие действия макроса "Auto_Open" при запуске приложения Excel выполнены не будут, поскольку запуск этого макроса происходит перед открытием книги по умолчанию и новой книги.
При обнаружении этих ограничений вместо записи макроса «Авто_открыть» необходимо создать процедуру на языке VBA для события Open, как описано в следующем разделе этой статьи.

Чтобы предотвратить автоматическое выполнение макроса "Auto_Open" при запуске Microsoft Excel, во время запуска удерживайте нажатой клавишу SHIFT.

Код: Выделить всё

Option Explicit
Private WithEvents App As Application
Private Sub Workbook_Open()
      Set App = Application
End Sub
Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
     If Wb.Name = "reestr.slk" Then
Call Макрос1   
 End If
   
   End Sub
Private Sub App_NewWorkbook(ByVal Wb As Workbook)
    Call Макрос1
End Sub

Код: Выделить всё

Sub макрос 2()
'

' 1
'

'
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
End Sub