Report stretching/reducing

[Filipe Martins]

Hello to all.

Ever had a problem when your print some reports in a printer other the
one you use more frequently, in which the report width span more tban
one page? I did, and didn't liked it.

But there's a simple way for automatically reducing the report size to
a size that prints well in the troubling printer. Here goes a sub that
receives the following parameters:

- repName : Report name;
- xFactor : Factor to be multiplied by the 'Left' and 'Width'
properties;
- yFactor : Factor to be multiplied by the 'Top' and 'Height'
properties;

So, 'StretchReport "Report1", 1.1, 0.95' stretches the height of
"Report1" by 10% and reduces it's width by 5%.

I hope that it will be useful to anyone. Please feel free to comment
the code and this article.
-- The Code -------------------------------------------------------------------

Option Compare Database
Option Explicit

Sub Demo()
Const kRepName = "EV - Registo de Visitas"
Const kXFact = -2.7
On Error Resume Next
DoCmd.Close acReport, kRepName, acSaveNo
On Error GoTo 0

StretchReport kRepName, kXFact

DoCmd.OpenReport kRepName, acViewPreview
End Sub
' Aplica um determinado factor ao tamanho e posição de todos os
controlos de um relatório.
' Argumentos:
' - 'repName': Nome do relatório;
' - 'xFactor': Factor a multiplicar pelas propriedades '.Left' e
'.Width' dos controlos;
' - 'yFactor': Factor a multiplicar pelas propriedades '.Top' e
'.Height' dos controlos;
' 'xFactor' e 'yFactor' devem ser a percentagem a esticar (se forem
positivos) ou a contraír
' (se forem negativos).
' Por exemplo, 'StretchReport "rep", 10, -5' estica a largura do
relatório 'rep' em 10% e
' contrai a sua altura em 5%.
' NOTA: O relatório é deixado aberto, com as alterações feitas por
guardar.
Sub StretchReport(repName As String, ByVal xFactor As Single, Optional
ByVal yFactor As Single = 0)
DoCmd.OpenReport repName, acViewDesign
Dim rep As Report
Set rep = Reports(repName)
Dim xf As Double
xf = 1 + xFactor / 100
Dim yf As Double
yf = 1 + yFactor / 100

Dim ctrl As Control
For Each ctrl In rep.Controls
ctrl.Left = Round(ctrl.Left * xf)
ctrl.Width = Round(ctrl.Width * xf)
ctrl.Top = Round(ctrl.Top * yf)
ctrl.Height = Round(ctrl.Height * yf)
Next
rep.Width = 0 ' Obrigar a assumir a largura mínima do relatório.
End Sub