VBA. Su evento stampa dimensionare al più alto tutti i controlli di form/report

[Bruno62]

Access 2003/2010

Buongiorno a voi tutti.
in un report sono presenti dieci controlli con bordatura di color nero, resi
espandibili e riducibili nelle propriet�. Purtroppo con i miei noti limiti
non riesco a scrivere due righe di codice per far si che su stampa i
controlli pi� bassi diventino alti quanto il controllo pi� alto per il suo
contenuto presente nel corpo del report.

Ho provato questo codice, se non erro tratto da sito comune, ma sfalsa tutti
i retangoli e ne esce un pastrocchio. Inoltre non sono riuscito ad adattarlo
solo per avere l'altezza dei controlli senza dover disegnare i rettangoli.

Grazie, Bruno

-----------------------

' Variabile impostata come vera durante l'esecuzione dell'evento
Report_Open.
Public blnOpening As Boolean


Private Sub Corpo_Print(Cancel As Integer, PrintCount As Integer)
'Routine che permette la visualizzazione della griglia in report tabulare
Dim ctl As Control
Dim altezza As Double
Dim larghezza As Double
Dim daMargine As Double
altezza = 0


'Cerco l'altezza massima
For Each ctl In Me.Corpo.Controls
If ctl.ControlType = acTextBox Then
If ctl.Height > altezza Then
altezza = ctl.Height
End If
End If
Next ctl
daMargine = 0

'Cerco la larghezza massima
For Each ctl In Me.Corpo.Controls
'If ctl.ControlType = acTextBox Then
'If ctl.Height > altezza Then
larghezza = ctl.Width
'End If
'End If
Next ctl
daMargine = 0


'Disegno i rettangoli attorno ad ogni campo
For Each ctl In Me.Corpo.Controls
If ctl.ControlType = acTextBox Then
Me.Line (daMargine, 0)-(daMargine + ctl.Width, altezza), , B
daMargine = daMargine + larghezza + ctl.Width
End If
Next ctl

End Sub

-----------------

[Bruno62]

[CUT]

Grazie ad un amico ho risolto il problema dei retangoli disegnati in modo
sfalsato per quanto riguarda la larghezza.
Ricordo che i controlli devono essere con proprietà espandibile e bordo
trasparente.

Ho provato ad effettuare la stessa cosa con le etichette, senza riuscire a
far fare il disegno attorno (vedasi seconda routine).
Se ritenete potete effettuare correzioni o miglioramenti.

Ciao, Bruno

------ 1^ routine --------

Private Sub Corpo_Print(Cancel As Integer, PrintCount As Integer)

'Routine su Corpo_Print che permette la visualizzazione della griglia in

report tabulare
Dim ctl As Control
Dim altezza As Double

Dim daMargine, Inizio As Double

altezza = 0

'Cerco l'altezza massima
For Each ctl In Me.Corpo.Controls
If ctl.ControlType = acTextBox Then
If ctl.Height > altezza Then
altezza = ctl.Height
End If
End If
Next ctl
daMargine = 0

'Disegno i rettangoli attorno ad ogni campo

For Each ctl In Me.Corpo.Controls
If ctl.ControlType = acTextBox Then

Select Case ctl.Name

Case Is = "Reparto"
Inizio = 0
Me.Line (Inizio, 0)-(Inizio + ctl.Width, altezza), , B

Case Is = "Struttura"
Inizio = ctl.Left
Me.Line (Inizio, 0)-(Inizio + ctl.Width, altezza), , B

Case Is = "Inv_Sic"
Inizio = ctl.Left
Me.Line (Inizio, 0)-(Inizio + ctl.Width, altezza), , B

Case Is = "ID_TIPOLOGIA STRUM CONTRATTO"
Inizio = ctl.Left
Me.Line (Inizio, 0)-(Inizio + ctl.Width, altezza), , B

Case Is = "Tipologia dettagli ARPAS"
Inizio = ctl.Left
Me.Line (Inizio, 0)-(Inizio + ctl.Width, altezza), , B

Case Is = "PRODUTTORE"
Inizio = ctl.Left
Me.Line (Inizio, 0)-(Inizio + ctl.Width, altezza), , B

Case Is = "MODELLO"
Inizio = ctl.Left
Me.Line (Inizio, 0)-(Inizio + ctl.Width, altezza), , B

Case Is = "MATRICOLA/SERIE"
Inizio = ctl.Left
Me.Line (Inizio, 0)-(Inizio + ctl.Width, altezza), , B

Case Is = "Dip_Toglire dal contratto"
Inizio = ctl.Left
Me.Line (Inizio, 0)-(Inizio + ctl.Width, altezza), , B


Case Is = "tipologia strum Contratto"
Inizio = ctl.Left
Me.Line (Inizio, 0)-(Inizio + ctl.Width, altezza), , B

Case Is = "DIP_ Osservazioni"
Inizio = ctl.Left
Me.Line (Inizio, 0)-(Inizio + ctl.Width, altezza), , B


End Select

End If
Next ctl

End Sub

------ 2^ routine --------

Private Sub IntestazioneGruppo1_Print(Cancel As Integer, PrintCount As
Integer)

'Routine su Intestazione_Print che permette la visualizzazione della griglia
disegnando i rettangoli attorno alle etichette

Dim ctl As Control
Dim altezza As Double

Dim daMargine, Inizio As Double

altezza = 0

'Cerco l'altezza massima

For Each ctl In Me.Section(5).Controls ' acGroupLevel1Header
If ctl.ControlType = acLabel Then

If ctl.Height > altezza Then
altezza = ctl.Height
End If
End If
Next ctl

daMargine = 0

'Disegno i rettangoli attorno ad ogni Etichetta

For Each ctl In Me.Section(5).Controls ' acGroupLevel1Header
If ctl.ControlType = acLabel Then

Select Case ctl.Name

Case Is = "Etichetta1"
Inizio = 0
Me.Line (Inizio, 0)-(Inizio + ctl.Width, altezza), , B

Case Is = "Etichetta2"
Inizio = ctl.Left
Me.Line (Inizio, 0)-(Inizio + ctl.Width, altezza), , B

Case Is = "Etichetta3"
Inizio = ctl.Left
Me.Line (Inizio, 0)-(Inizio + ctl.Width, altezza), , B

Case Is = "Etichetta4"
Inizio = ctl.Left
Me.Line (Inizio, 0)-(Inizio + ctl.Width, altezza), , B

Case Is = "Etichetta5"
Inizio = ctl.Left
Me.Line (Inizio, 0)-(Inizio + ctl.Width, altezza), , B

Case Is = "Etichetta6"
Inizio = ctl.Left
Me.Line (Inizio, 0)-(Inizio + ctl.Width, altezza), , B

Case Is = "Etichetta7"
Inizio = ctl.Left
Me.Line (Inizio, 0)-(Inizio + ctl.Width, altezza), , B

Case Is = "Etichetta8"
Inizio = ctl.Left
Me.Line (Inizio, 0)-(Inizio + ctl.Width, altezza), , B

Case Is = "Etichetta9"
Inizio = ctl.Left
Me.Line (Inizio, 0)-(Inizio + ctl.Width, altezza), , B


Case Is = "Etichetta10"
Inizio = ctl.Left
Me.Line (Inizio, 0)-(Inizio + ctl.Width, altezza), , B

Case Is = "Etichetta11"
Inizio = ctl.Left
Me.Line (Inizio, 0)-(Inizio + ctl.Width, altezza), , B


End Select