Newsgroup: it.comp.appl.access
Titolo: VBA. Su evento stampa dimensionare al più alto tutti i controlli di form/report

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
 
----------------- 
 
 

 
[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
