Bonjour,
J'ai une base dans laquelle je crée des états par code (le motif serait
assez long à expliquer).
La création est de l'état est rapide... L'inconvénient est de ne pas pouvoir
utiliser ça dans un mde.
Voilà un exemple de procédure "brut de décoffrage", si ça peut aider.
Mais c'est vrai, come le dit Raymond, que c'est assez long à mettre en
place... Faut voir si le jeu en vaut la chandelle !
Sub Cree_Etat_Largeur(BLN_LARGEUR_FIXE As Boolean, _
bln_Moy As Boolean, BLN_MIN_MAX, Hauteur_Label As Integer,
Larg_Trait_Hor As Integer, _
Int_Left_Trait_Hor As Integer, Nom_Etat As String, Optional
Taille_Police As Byte = 8, _
Optional Hauteur_Ligne As Integer = 240, Optional
STYLE_FOND_CONTROLE As Long = 1)
'BLN_LARGEUR_FIXE : Si True, les champs ont une largeur fixe et sont tous
créés. Si False, largeur variable dépendant
'de Largeur_Etat, créés si Visible = True
'BLN_MOY : Crée-t-on des contrôles moyenne dans le pied d'état
'BLN_MIN_MAX : Crée-t-on des contrôles min et max dans le pied d'état
'Hauteur_Label : hauteur des contrôles étiquettes. Fournir 240 pour une
taille standart
'Larg_Trait_Hor : Variable ByRef servant uniquement à récupérer la valeur de
retour dans la procédure
'appelante de la largeur des traits horizontaux verticaux
'Int_Left_Trait_Hor : Variable ByRef servant uniquement à récupérer la
valeur de retour dans la procédure
'appelante de la propriété Left des traits horizontaux
verticaux
'Taille_Police : Taille de la police des contrôles de la section détail (8
si non fourni)
'Hauteur_Ligne : Hauteur des lignes de la colonne détail (240 par défaut)
'STYLE_FOND_CONTROLE : Style de fond des contrôles texte dans la section
détail : 1=Normal, 0=Transparent
'Objectif : Créer un état basé sur une requête ou table donnée (Par exemple
Global_Controle)
'en utilisant la table Largeur_Etat (ou une autre table possédant les
largeurs des champs).
'Si cette table n'existe pas, il est toujours possible de la créer
automatiquement juste
'avant d'appeler cette procédure en utilisant Remplir_Largeur_Index
'PROBLEME : les contrôles qui devraient être créés ds en-tête et pied d'état
le sont
'ds en-tête et pied de page car ça plante autrement
Dim Rpt As Report
Dim ctlLabel As Control
Dim CtlText As Control
Dim CtlMoy As Control
Dim CtlMin As Control
Dim CtlMax As Control
Dim CtlLine As Control
Dim CtlLineEt As Control
Dim CtlLineMin As Control
Dim CtlLineMax As Control
Dim CtlLineMoy As Control
Dim CtlLine_Hor As Control
Dim IntLarg As Integer
Dim CustControl As String
Dim n As Integer 'Numero de controle et Numero_Ordre dans table
Largeur_Etat
Dim i As Byte 'Numero pour mémoriser le dernier contrôle défini pour
faire le dernier trait vertical à droite du dernier contrôle
Dim Rst As Recordset
Dim RptName As String
Dim S_Largeur As Single
Dim Num_Bloc As Byte
Dim Num_Trait As Long
Dim Larg_Trait As Integer
Const Nom_Table = "Largeur_Etat" 'Nom de la table qui contient les
largeurs d'état
Const NOM_REC = "Global_Controle" 'Nom de la table ou requête qur
laquelle baser l'état
Const NOM_INDEX = "multiple" 'Nom de l'index ds la table
Largeur_Etat
Const INT_HAUT = 0 'Espace en twips de l'en-tête de page
au dessus de la
'ligne des étiquettes
Const HAUT_CTL = 240 'Hauteur en twips des controles
Const INT_ENTRE = 50 'Espace en twips entre les contrôles
Const INT_DEB = 25 'Espace à gauche du premier contrôle en twips (567
twips / cm)
'Attention : INT_DEB doit être au moins égal à la moitié
de INT_ENTRE
On Error Resume Next
DoCmd.DeleteObject acReport, Nom_Etat
On Error GoTo 0
Set Rpt = CreateReport
Rpt.RecordSource = NOM_REC
RptName = Rpt.Name
DoCmd.RunCommand acCmdPageHdrFtr
DoCmd.RunCommand acCmdReportHdrFtr
IntLarg = INT_DEB
Set Rst = DB2.OpenRecordset(Nom_Table)
Rst.Index = NOM_INDEX
Num_Bloc = Rst!Num_Bloc
n = 1
Do While Not Rst.EOF
Rst.Seek "=", NOM_REC, n
If Not Rst.NoMatch Then
If Rst!A_Utiliser Then
S_Largeur = Rst!Largeur_Col
If BLN_LARGEUR_FIXE Then S_Largeur = 0.5
CustControl = Rst!Nom_Champ
If Rst!Num_Bloc <> Num_Bloc Then 'pour tracer les
rectangles au lieu
Num_Bloc = Rst!Num_Bloc 'des traits
Num_Trait = 101
Larg_Trait = 50
Else
Num_Trait = 102
Larg_Trait = 0
End If
IntLarg = IntLarg + Larg_Trait '=> rectangles
Set CtlText = CreateReportControl(Rpt.Name, acTextBox,
acDetail, , CustControl, IntLarg, 15, S_Largeur * 567, Hauteur_Ligne - 15)
'on est obligé de positionner le contrôle à 15 twips du
haut sinon les traits horizontaux ne s'affichent pas complétement
'De même, la hauteur est déterminée à 225 twips (c'est à
dire 240 pour la hauteur standart - 15 twips de décalage en haut de chaque
ligne
CtlText.fontsize = Taille_Police
CtlText.Name = "C" & n
CtlText.BackStyle = STYLE_FOND_CONTROLE
If Not IsNull(Rst!Nb_Decimale) Then
CtlText.Format = "Fixed"
CtlText.DecimalPlaces = Rst!Nb_Decimale
End If
If bln_Moy Then
Set CtlMoy = CreateReportControl(Rpt.Name, acTextBox,
acFooter, , "=Avg([" & CustControl & "])", IntLarg, 0, S_Largeur * 567)
CtlMoy.Name = "Moy_" & "C" & n
If Not IsNull(Rst!Nb_Decimale) Then
CtlMoy.Format = "Fixed"
CtlMoy.DecimalPlaces = Rst!Nb_Decimale
CtlMoy.BackColor = 11796479
CtlMoy.BackStyle = 1
End If
End If
If BLN_MIN_MAX Then
Set CtlMin = CreateReportControl(Rpt.Name, acTextBox,
acFooter, , "=min([" & CustControl & "])", IntLarg, 300, S_Largeur * 567)
CtlMin.Name = "Min_" & "C" & n
If Not IsNull(Rst!Nb_Decimale) Then
CtlMin.Format = "Fixed"
CtlMin.DecimalPlaces = Rst!Nb_Decimale
End If
Set CtlMax = CreateReportControl(Rpt.Name, acTextBox,
acFooter, , "=max([" & CustControl & "])", IntLarg, 600, S_Largeur * 567)
CtlMax.Name = "Max_" & "C" & n
If Not IsNull(Rst!Nb_Decimale) Then
CtlMax.Format = "Fixed"
CtlMax.DecimalPlaces = Rst!Nb_Decimale
End If
End If
Set ctlLabel = CreateReportControl(Rpt.Name, acLabel,
acHeader, , Rst!Nom_Etiquette, IntLarg, INT_HAUT, S_Largeur * 567,
Hauteur_Label)
ctlLabel.Properties("width") = S_Largeur * 567
ctlLabel.Properties("height") = Hauteur_Label
ctlLabel.Name = "Etiquette_" & "C" & n
ctlLabel.TextAlign = 2 'On centre le texte de l'étiquette
Set CtlLine = CreateReportControl(Rpt.Name, Num_Trait,
acDetail, , CustControl, IntLarg - Larg_Trait - INT_ENTRE \ 2, 0,
Larg_Trait, Hauteur_Ligne)
CtlLine.Name = "Trait_" & "C" & n
If Num_Trait = 101 Then CtlLine.BackColor = 8421504
Set CtlLineEt = CreateReportControl(Rpt.Name, Num_Trait,
acHeader, , CustControl, IntLarg - Larg_Trait - INT_ENTRE \ 2, INT_HAUT,
Larg_Trait, Hauteur_Label)
CtlLineEt.Name = "TraitEt_" & "C" & n
If Num_Trait = 101 Then CtlLineEt.BackColor = 8421504
If bln_Moy Then
Set CtlLineMoy = CreateReportControl(Rpt.Name,
Num_Trait, acFooter, , CustControl, IntLarg - Larg_Trait - INT_ENTRE \ 2, 0,
Larg_Trait, 270)
CtlLineMoy.Name = "TraitMoy_" & "C" & n
If Num_Trait = 101 Then CtlLineMoy.BackColor = 8421504
End If
If BLN_MIN_MAX Then
Set CtlLineMin = CreateReportControl(Rpt.Name,
Num_Trait, acFooter, , CustControl, IntLarg - Larg_Trait - INT_ENTRE \ 2,
270, Larg_Trait, 300)
CtlLineMin.Name = "TraitMin_" & "C" & n
If Num_Trait = 101 Then CtlLineMin.BackColor = 8421504
Set CtlLineMax = CreateReportControl(Rpt.Name,
Num_Trait, acFooter, , CustControl, IntLarg - Larg_Trait - INT_ENTRE \ 2,
570, Larg_Trait, 270)
CtlLineMax.Name = "TraitMax_" & "C" & n
If Num_Trait = 101 Then CtlLineMax.BackColor = 8421504
End If
IntLarg = IntLarg + S_Largeur * 567 + INT_ENTRE
i = n
End If 'If Rst!A_Utiliser Then
End If 'If Not Rst.NoMatch Then
Rst.MoveNext
n = n + 1
Loop
Set CtlLine = CreateReportControl(Rpt.Name, acLine, acDetail, , ,
IntLarg - INT_ENTRE \ 2, , 0, Hauteur_Ligne)
CtlLine.Name = "Trait_" & "C" & i + 1 'Trait à droite de la dernière
zone de texte
Set CtlLineEt = CreateReportControl(Rpt.Name, acLine, acHeader, , ,
IntLarg - INT_ENTRE \ 2, INT_HAUT, 0, Hauteur_Label)
CtlLineEt.Name = "TraitEt_" & "C" & i + 1 'Trait à droite de la dernière
étiquette
If bln_Moy Then
Set CtlLineMoy = CreateReportControl(Rpt.Name, acLine, acFooter, , ,
IntLarg - INT_ENTRE \ 2, 0, 0, 270)
CtlLineMoy.Name = "TraitMoy_" & "C" & i + 1 'Trait à droite de la
moyenne
End If
If BLN_MIN_MAX Then
Set CtlLineMin = CreateReportControl(Rpt.Name, acLine, acFooter, , ,
IntLarg - INT_ENTRE \ 2, 270, 0, 300)
CtlLineMin.Name = "TraitMin_" & "C" & i + 1 'Trait à droite du minimum
Set CtlLineMax = CreateReportControl(Rpt.Name, acLine, acFooter, , ,
IntLarg - INT_ENTRE \ 2, 570, 0, 270)
CtlLineMax.Name = "TraitMax_" & "C" & i + 1 'Trait à droite du max
End If
Larg_Trait_Hor = IntLarg - INT_ENTRE \ 2 - (INT_DEB - INT_ENTRE \ 2)
Int_Left_Trait_Hor = INT_DEB - INT_ENTRE \ 2
Set CtlLine_Hor = CreateReportControl(Rpt.Name, acLine, acHeader, , ,
Int_Left_Trait_Hor, INT_HAUT + Hauteur_Label, Larg_Trait_Hor, 0)
CtlLine_Hor.Name = "TraitHor_1" 'Trait horizontal en dessous des
étiquettes
Set CtlLine_Hor = CreateReportControl(Rpt.Name, acLine, acDetail, , ,
Int_Left_Trait_Hor, Hauteur_Ligne, Larg_Trait_Hor, 0)
CtlLine_Hor.Name = "TraitHor_2" 'Trait horizontal en dessous des zones
de texte
Set CtlLine_Hor = CreateReportControl(Rpt.Name, acLine, acHeader, , ,
Int_Left_Trait_Hor, INT_HAUT, Larg_Trait_Hor, 0)
CtlLine_Hor.Name = "TraitHor_3" 'Trait horizontal au dessus des
étiquettes
If bln_Moy Then
Set CtlLine_Hor = CreateReportControl(Rpt.Name, acLine, acFooter, , ,
Int_Left_Trait_Hor, 0, Larg_Trait_Hor, 0)
CtlLine_Hor.Name = "TraitHor_4" 'Trait horizontal au dessus de la
moyenne
Set CtlLine_Hor = CreateReportControl(Rpt.Name, acLine, acFooter, , ,
Int_Left_Trait_Hor, 270, Larg_Trait_Hor, 0)
CtlLine_Hor.Name = "TraitHor_5" 'Trait horizontal entre la moyenne
et le min
End If
If BLN_MIN_MAX Then
Set CtlLine_Hor = CreateReportControl(Rpt.Name, acLine, acFooter, , ,
Int_Left_Trait_Hor, 570, Larg_Trait_Hor, 0)
CtlLine_Hor.Name = "TraitHor_6" 'Trait horizontal entre le min et
le max
Set CtlLine_Hor = CreateReportControl(Rpt.Name, acLine, acFooter, , ,
Int_Left_Trait_Hor, 870, Larg_Trait_Hor, 0)
CtlLine_Hor.Name = "TraitHor_7" 'Trait horizontal en dessous du max
End If
Rpt.Section(acDetail).Height = 0
Rpt.Section(acHeader).Height = Hauteur_Label + INT_HAUT + 2 'Si on ne
rajoute pas ce 2, le trait horizontal en dessous des étiquettes n'est que
partiellement affiché
Rpt.Section(acFooter).Height = 270
Set ctlLabel = Nothing
Set CtlLine = Nothing
Set CtlLine_Hor = Nothing
Set CtlLineEt = Nothing
Set CtlLineMax = Nothing
Set CtlLineMin = Nothing
Set CtlLineMoy = Nothing
Set CtlMax = Nothing
Set CtlMin = Nothing
Set CtlMoy = Nothing
Set CtlText = Nothing
Set Rst = Nothing
Set Rpt = Nothing
DoCmd.Close , , acSaveYes
DoCmd.Rename Nom_Etat, acReport, "État1"
End Sub
--
snack
Utiliser microsoft.public.fr.access...
http://users.skynet.be/mpfa/charte.htm
"***@bluwin.ch" <***@discussions.microsoft.com> a écrit
dans le message news: 008a01c39cbf$0355ff40$***@phx.gbl...
Bonjour,
Une personne m'a dit qu'il existait un moyen pour créer
entièrement des états dans Access avec du code VBA.
Je n'en sais pas plus, mais en avez-vous entendu parler,
car ce serait très intéressant.
On pourrait imaginer par exemple de cocher dans un
formulaire les colonnes que l'on souhaite afficher dans
l'état, et l'état se construit en fonction des cases
activées (ce n'est qu'un exemple qui m'est passé par la
tête).
Alors, la possibilité de créer entièrement un état avec
du code VBA. Info ou intox ?
Merci de vos lumières
Cordiales salutations
André