Discussion :

[patbeautifulday]

Bonjour à tous

Je cherche à créer dynamiquement un sous-formulaire en se basant sur l'évènement Form_Current() du formulaire parent. Celui-ci appelle une fonction que j'ai trouvé dans la FAQ et que j'ai adapté. Cette fonction est bien codée dans un module externe.
Voici le code de ma fonction :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
Public Function create_form(sql As String, nom As String) As String
 
Dim frm As Form
Dim rst As Recordset
Dim ctl As Control
Dim i, j As Integer
Dim str As String
 ' --Ouvrir le formulaire en mode modification et caché
DoCmd.OpenForm "sfrdyn", acDesign
 
 ' --suppression de tous les contrôles avant de les créer de nouveau
For Each ctl In Forms!sfrdyn.Controls
        DeleteControl "sfrdyn", ctl.name
Next ctl
 ' --Source de données de mon formulaire
Forms!sfrdyn.RecordSource = sql
Set rst = CurrentDb.OpenRecordset(sql)
 
'    str = "TRANSFORM sum(recep) SELECT iif(produit=0,'autres','produits') AS type FROM HPROD " & _
'    "where entrepot='" & Forms!activentrepot1.entrepot & "' and dathis>=" & dathis(Forms!activentrepot1.txtdeb) & " and dathis<=" & dathis(Forms!activentrepot1.txtfin) & _
'    " GROUP BY produit PIVOT weekDay(DateSerial(CInt(Left(Str(dathis),5)),CInt(Mid(Str(dathis),6,2)),CInt(Right(Str(dathis),2))));"
'    Me.RecordSource = str
'    'Debug.Print str
'    'Me.Requery
 
' --Source de données de mon formulaire
Forms!sfrdyn.RecordSource = str
Set rst = CurrentDb.OpenRecordset(str)
 ' --nous ne pensons pas que vous aurez plus de 100 contrôles
Dim controle(1 To 100) As Control
 
' --Création des entêtes
j = 1250
h = 340
i = 0
While (i + 1) <= rst.Fields.Count
        Set controle(i) = CreateControl("sfrdyn", acTextBox, acHeader)
        controle(i).name = rst.Fields(i).name
        controle(i).Text = IIf(rst.Fields(i).name = "type", "type de flux", WeekdayName(Left(rst.Fields(i).name, 1)) & Right(rst.Fields(i).name, Len(rst.Fields(i).name) - 1))
'        Select Case Left(rst.Fields(i).name, 1)
'            Case "t"
'                controle(i).Text = "Type de Flux"
'            Case "1"
'                controle(i).Text = Replace(rst.Fields(i).name, "1", "Dimanche")
'            Case "2"
'                controle(i).Text = Replace(rst.Fields(i).name, "2", "Lundi")
'            Case "3"
'                controle(i).Text = Replace(rst.Fields(i).name, "3", "Mardi")
'            Case "4"
'                controle(i).Text = Replace(rst.Fields(i).name, "4", "Mercredi")
'            Case "5"
'                controle(i).Text = Replace(rst.Fields(i).name, "5", "Jeudi")
'            Case "6"
'                controle(i).Text = Replace(rst.Fields(i).name, "6", "Vendredi")
'            Case "7"
'                controle(i).Text = Replace(rst.Fields(i).name, "7", "Samedi")
'            Case Else
'                controle(i).Text = "autre"
'        End Select
        controle(i).Left = (i) * j
        controle(i).Width = j
        controle(i).Height = h
        controle(i).BackColor = "917598"
        controle(i).SpecialEffect = 0 ' gravé, 3D, etc...
        controle(i).BorderStyle = 1
        controle(i).TextAlign = 2  'texte centré
        controle(i).FontWeight = 700 ' =Gras, normal = 400
        controle(i).ForeColor = "16777215"
        'controle(i).ControlSource = "=\'" & rst.Fields(i).Name & "\'"
        i = i + 1
        j = j + 1150
Wend
 
'
' ' --Création des contrôles
'If rst.RecordCount <> 0 Then
'    i = 1
'    j = 1000
'    While i < rst.Fields.Count
'    ' -- Créer le contrôle i
'    Set controle(i) = CreateControl("F_AFFICHAGE", acTextBox)
'    ' --lui affecter un nom
'    controle(i).Name = "TXT_" & rst.Fields(i).Name
'    ' --le positionner sur le formulaire
'    controle(i).Left = 100 + j
'    ' --Définir sa largeur
'    controle(i).Width = 1150
'    ' --Définir sa couleur de fond
'    controle(i).BackColor = "14742270"
'    ' --Définir son effet visuel
'    controle(i).SpecialEffect = 0
'    controle(i).BackStyle = 0
'    controle(i).BorderStyle = 1
'    ' --source de données de ce contrôle
'    controle(i).ControlSource = rst.Fields(i).Name
'    i = i + 1
'    j = j + 1150
'    Wend
'End If
 
rst.Close
Set rst = Nothing
' --Sauvegarder le formulaire
DoCmd.Save acForm, nom
create_form = nom
End Function

Voici le code de ma procédure évènementielle du formulaire parent :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Private Sub Form_Current()
    Dim qdf As DAO.QueryDef
    Set qdf = CurrentDb.QueryDefs![RqSomRecProdParJour2]
    Me.sfr.SourceObject = create_form(qdf.sql, "sfrdynessai")
End Sub

.

Le formulaire sfrdyn existe bien dans ma base, mais impossible de l'ouvrir en mode création, mais j'y arrive en mode normal (acNormal).

Message d'erreur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

L'action 'openform' a été annulée

Quel est le problème ?
Merci d'avance

[Invité]

Bonjour

Vu que c'est un sous-formulaire, est-ce que celui-ci est ouvert actuellement dans ton formulaire maitre ?

Si c'est le cas, je pense que cela vient de là, il faudrait avant le décharger de ce formulaire maitre, et ensuite le remettre comme source du sous-formulaire.

Philippe

[patbeautifulday]

Merci Philippe

C'était effectivement le problème : ne rien mettre dans la source du contrôle sous-formulaire, et l'affecter une fois les contrôles créés.
Pour info, mon code modifié :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
Public Function create_form(sql As String, nom As String) As String
 
Dim frm As Form
Dim rst As Recordset
Dim ctl As Control
Dim i, j As Integer
Dim str As String
 ' --Ouvrir le formulaire en mode modification et caché
DoCmd.OpenForm "sfrdyn", acDesign
'DoCmd.Save acForm, "sfrdyn"
 ' --suppression de tous les contrôles avant de les créer de nouveau
'For Each ctl In Forms!sfrdyn.Controls
'    DeleteControl "sfrdyn", ctl.name
'Next ctl
While Not (Forms!sfrdyn.Controls.Count = 0)
    DeleteControl "sfrdyn", Forms!sfrdyn.Controls(0).name
Wend
 ' --Source de données de mon formulaire
Forms!sfrdyn.RecordSource = sql
Set rst = CurrentDb.OpenRecordset(sql)
 
 ' --nous ne pensons pas que vous aurez plus de 100 contrôles
Dim controle(0 To 100) As Control
 
' --Création des entêtes
j = 1250
h = 340
i = 0
While i < rst.Fields.Count
    Set controle(i) = CreateControl("sfrdyn", acTextBox, acHeader)
    controle(i).name = rst.Fields(i).name
    controle(i).Left = (i) * j
    controle(i).Width = j
    controle(i).Height = h
    controle(i).BackColor = "917598"
    controle(i).SpecialEffect = 0 ' gravé, 3D, etc...
    controle(i).BorderStyle = 1
    controle(i).TextAlign = 2  'texte centré
    controle(i).FontWeight = 700 ' =Gras, normal = 400
    controle(i).ForeColor = "16777215"
    If IsNumeric(Left(rst.Fields(i).name, 1)) Then
        controle(i).ControlSource = "='" & WeekdayName(Left(rst.Fields(i).name, 1), , vbSunday) & Right(rst.Fields(i).name, (Len(rst.Fields(i).name) - 1)) & "'"
    Else
        controle(i).ControlSource = "='" & rst.Fields(i).name & "'"
    End If
    i = i + 1
Wend
    'Création de l'entête du textbox 'TOTAL'
    Set controle(i + 1) = CreateControl("sfrdyn", acTextBox, acHeader)
    controle(i + 1).name = "TOTAL"
    controle(i + 1).Left = i * j
    controle(i + 1).Width = j
    controle(i + 1).Height = h
    controle(i + 1).BackColor = "917598"
    controle(i + 1).SpecialEffect = 0 ' gravé, 3D, etc...
    controle(i + 1).BorderStyle = 1
    controle(i + 1).TextAlign = 2  'texte centré
    controle(i + 1).FontWeight = 700 ' =Gras, normal = 400
    controle(i + 1).ForeColor = "16777215"
    controle(i + 1).ControlSource = "='TOTAL'"
    i = 0
 
 
 
 
'
' ' --Création des contrôles
'If rst.RecordCount <> 0 Then
'    i = 1
'    j = 1000
'    While i < rst.Fields.Count
'    ' -- Créer le contrôle i
'    Set controle(i) = CreateControl("F_AFFICHAGE", acTextBox)
'    ' --lui affecter un nom
'    controle(i).Name = "TXT_" & rst.Fields(i).Name
'    ' --le positionner sur le formulaire
'    controle(i).Left = 100 + j
'    ' --Définir sa largeur
'    controle(i).Width = 1150
'    ' --Définir sa couleur de fond
'    controle(i).BackColor = "14742270"
'    ' --Définir son effet visuel
'    controle(i).SpecialEffect = 0
'    controle(i).BackStyle = 0
'    controle(i).BorderStyle = 1
'    ' --source de données de ce contrôle
'    controle(i).ControlSource = rst.Fields(i).Name
'    i = i + 1
'    j = j + 1150
'    Wend
'End If
 
rst.Close
Set rst = Nothing
' --Sauvegarder le formulaire
'Forms!sfrdyn.name = nom
DoCmd.Save acForm, "sfrdyn"
DoCmd.Close acForm, "sfrdyn"
create_form = nom
End Function

Cependant il me bloque maintenant au moment du :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
DoCmd.Save acForm, "sfrdyn"

Message d'erreur:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Microsoft ACCES ne peut achever l'opération : vous devez interrompre l'exécution du code et recommencer

[Invité]

Re

Je pense (hypothèse) qu'il n'a pas fini la création alors que tu demandes la sauvegarde.

Essayes en mettant l'instruction DoEvents avant la sauvegarde pour voir (sans garantie).

Philippe

[patbeautifulday]

Merci Philippe, d'être toujours présent sur ce post.
J'ai résolu mon problème en faisant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

DoCmd.Close acForm, "sfrdyn", acSaveYes

au lieu de :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

DoCmd.Save acForm, "sfrdyn"

Au passage, sais-tu comment faire pour renommer le formulaire "sfrdyn" en "nom" ?

[Invité]

Re

Merci Philippe, d'être toujours présent sur ce post.

Tu as de la chance, je suis très occupé

Regardes du coté de : DoCmd.Rename

Philippe