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

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

alter interface PRINTT13 (fix 'Альбомная ориентация');
var b_PrintRep : boolean;
procedure mySetOrientation;
{
  var iStrFunc : StringFunctions;
  var FileName, VBSFileName : string;
  FileName := CreateTmpFileName;
  VBSFileName := TranslatePath ( GetStringParameter ( 'Files','OutputFilesDirectory', 0 ) + 'tdmacro_prs.vbs' );
  //message(CurrentFileName)
  if instr('out', CurrentFileName)<> 0 then exit;                          //если *.OUT файл, то ниннада
  LogStrToFile ( FileName, oem2ansi( 'wdReplaceAll = 2') );
  LogStrToFile ( FileName, oem2ansi( 'Dim aStory') );                     // As Range
  LogStrToFile ( FileName, oem2ansi( 'Dim aField') );                     // As Field
  LogStrToFile ( FileName, oem2ansi( 'Dim myTOC') );                      // As TableOfContents

  LogStrToFile ( FileName, oem2ansi( 'Dim activeDoc') );

  LogStrToFile ( FileName, oem2ansi( 'Dim oDoc') );
  LogStrToFile ( FileName, oem2ansi( 'Dim oXls') );
  LogStrToFile ( FileName, oem2ansi( 'Dim bActXls') );
  LogStrToFile ( FileName, oem2ansi( 'dim bkActive') );
  LogStrToFile ( FileName, oem2ansi( 'Dim objWorksheet') );
  LogStrToFile ( FileName, oem2ansi( 'dim shActive') );
  If FileExist ( VBSFileName ) {
  LogStrToFile ( FileName, oem2ansi( 'bActXls = true ' ));
   }
  LogStrToFile ( FileName, oem2ansi( 'Set WshShell = CreateObject("WScript.Shell")') );
  LogStrToFile ( FileName, oem2ansi( 'On Error Resume next ') );                         //дает возможность обработать ошибку, а не выводить её
  LogStrToFile ( FileName, oem2ansi( 'do while bActXls ' ));
  LogStrToFile ( FileName, oem2ansi( 'if WshShell.AppActivate("TabT13") then ') );       //ждем когда можно активировать окно в заголовке которого есть нужные символы
  LogStrToFile ( FileName, oem2ansi( '  Set oXls = GetObject(,"Excel.Application")') )
  LogStrToFile ( FileName, oem2ansi( '  if err.number<>0 then bActXls = false  ') )      //даст возможность выйти из цикла при ошибке создания объекта эксель (это когда отчет word запустили)
  LogStrToFile ( FileName, oem2ansi( '  If Not (oXls Is Nothing) then') );               //при предыдущей ошибке не выполнится условие
  LogStrToFile ( FileName, oem2ansi( '   set bkActive = oXls.ActiveWorkbook') );
  //LogStrToFile ( FileName, oem2ansi( '   WScript.Echo ( bkActive.Name ) ') );
  LogStrToFile ( FileName, oem2ansi( '   If InStr(1,bkActive.Name,"TabT13") then ') );
  LogStrToFile ( FileName, oem2ansi( '     Set shActive = bkActive.Sheets(1) ') );
  LogStrToFile ( FileName, oem2ansi( '     Const xlLandscape = 2') );
  LogStrToFile ( FileName, oem2ansi( '     With shActive.Pagesetup') );
  LogStrToFile ( FileName, oem2ansi( '       .Orientation = xlLandscape') );
  LogStrToFile ( FileName, oem2ansi( '       .Zoom = 78') );
  LogStrToFile ( FileName, oem2ansi( '       .LeftMargin = oXls.InchesToPoints(0.7)') );
  LogStrToFile ( FileName, oem2ansi( '       .RightMargin = oXls.InchesToPoints(0.7)') );
  LogStrToFile ( FileName, oem2ansi( '       .TopMargin = oXls.InchesToPoints(0.512)') );
  LogStrToFile ( FileName, oem2ansi( '       .BottomMargin = oXls.InchesToPoints(0.63)') );
  LogStrToFile ( FileName, oem2ansi( '       .HeaderMargin = oXls.InchesToPoints(0)') );
  LogStrToFile ( FileName, oem2ansi( '       .FooterMargin = oXls.InchesToPoints(0)') );
  LogStrToFile ( FileName, oem2ansi( '       .PrintQuality = 600') );
  LogStrToFile ( FileName, oem2ansi( '       .Draft = False') );
  LogStrToFile ( FileName, oem2ansi( '       .FitToPagesWide = 1') );
  LogStrToFile ( FileName, oem2ansi( '     End With ') );
  LogStrToFile ( FileName, oem2ansi( '     bActXls = false ') );
  LogStrToFile ( FileName, oem2ansi( '     bkActive.Save ') );
  LogStrToFile ( FileName, oem2ansi( '   End If') );
  LogStrToFile ( FileName, oem2ansi( '  End If') );
  LogStrToFile ( FileName, oem2ansi( 'End If') );
  LogStrToFile ( FileName, oem2ansi( 'Loop') );
  If FileExist ( VBSFileName )
     DeleteFile ( VBSFileName );

     var iErrorCode : integer

 if CopyMoveFile ( FileName, VBSFileName, true, ecmfClientFrom + ecmfClientTo )
   ExecProgram ( 'start', VBSFileName,'Альбомная ориентация...',pfSilent,iErrorCode );
 //   message('ошибок не обнаружено, файл ' + Filename + ' перемещается в файл ' + VBSFileName)

}
HandleEvent
cmOk :
{ 
  if inherited::handleevent(cmOk)<> heAbort  then
     {
       if(GetFieldStringValue (#TYPEREP))='0' then mySetOrientation   //тип отчета текст, в нем есть наш slk
     }
}
end;
end.