Discussion :

[morobaboumar]

Bonsoir membres du forum !

La fonction suivante me permet de générer les infos dans la table tmois avec l'aide d'une 2e table Tbl_Intervalle_Periode:

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
 
Private Sub GenererTableMois()
On Error GoTo OUMAR
Dim strMois As String
Dim strAnnee As String
Dim X As Integer
Dim i As Integer
Dim j As Integer
 
DoCmd.SetWarnings False
 
DoCmd.RunSQL "delete * from tmois;"
j = 1
DoEvents
For i = -Me.X To Me.Y
strMois = CStr(UCase(MonthName(Month(DateAdd("m", i, date))) & " " & Year(DateAdd("m", i, date))))
strAnnee = Year(DateAdd("m", i, date))
DoCmd.RunSQL "insert into tmois(LibMois,id,Annee_tMois) values ('" & strMois & "'," & j & ",'" & strAnnee & "');"
j = j + 1
'Me.cptantpour.AddItem UCase(MonthName(Month(DateAdd("m", i, date))) & " " & Year(DateAdd("m", i, date)))
Next i
DoCmd.SetWarnings True
 
Exit Sub
OUMAR:
    MsgBox "Erreur n° " & err.Number & vbCrLf & err.description, vbCritical + vbOKOnly, "Une erreur est survenue"
End Sub

Je recherche une méthode plus simple pour générer les infos dans ma table tMois sans déranger les anciennes données qui s'y trouvent.

- Pièce jointe de la BD

Cordialement.

[hyperion13]

Salut
Je reformule, parce que j'ai un peu de mal à comprendre.
Si j'ai bien compris, à l'aide des éléments de la tbl intervalleperiode vous voudriez créer une liste de mois compris entre année X et année Y de votre date système et ajouter cette liste dans la tblmois sans doublons !

[morobaboumar]

Bonjour hyperion13,
bonjour membres du forum !
Oui c'est exactement cela que je recherche.
Cordialement.

[hyperion13]

Voici un code que j'utilise, à vous de l'adapter à votre IHM
Je passe par un form indépendant avec 2 textbox (txtmoisdeb et txtmoisfin), via l'évènement sur click d'un btn, je crée une tbl_tmp qui est alimentée en boucle d'une liste de mois entre txtmoisdeb et txtmoisfin. Et enfin j'alimente la tblMois sans doublons.

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
Private Sub Commande25_Click()
Dim i As Date, j As Date, l As Date, y As Date, k As Integer, m As Integer, z As Integer
 
DoCmd.SetWarnings False
CurrentDb.Execute "CREATE TABLE tblMois_tmp (" _
    & " id_tmp AutoIncrement CONSTRAINT idxid Primary Key, " _
    & " moisdeb_tmp Date, " _
    & " moisfin_tmp Date, " _
    & " numannee_tmp Integer, nummois_tmp Integer, numjour_tmp Integer, " _
    & " CONSTRAINT idxanmois UNIQUE (numannee_tmp, nummois_tmp))", dbFailOnError
 
i = Me.txtmoisdeb
j = Me.txtmoisfin
k = DateDiff("m", DateSerial(Year(i), Month(i), 1), DateSerial(Year(j), Month(j), 1))
 
For z = 0 To k
    l = DateAdd("m", z, i)
    CurrentDb.Execute "INSERT INTO tblMois_tmp (moisdeb_tmp, moisfin_tmp, numannee_tmp, nummois_tmp, numjour_tmp)" _
    & " VALUES (#" & Format(l, "mm/dd/yyyy") & "#, #" & DateSerial(Year(l), Month(l) + 1, 0) & "#, " & Year(l) & ", " & Month(l) & ", " & Day(DateSerial(Year(l), Month(l) + 1, 0)) & ")", dbFailOnError
Next z
    CurrentDb.Execute "INSERT INTO tblMois (moisdeb, moisfin, numannee, nummois, numjour)" _
    & " SELECT moisdeb_tmp, moisfin_tmp, numannee_tmp, nummois_tmp, numjour_tmp" _
    & " FROM tblMois_tmp" _
    & " WHERE moisdeb_tmp Not In (SELECT moisdeb FROM tblMois)", dbFailOnError
DoCmd.DeleteObject acTable, "tblMois_tmp"
DoCmd.SetWarnings True
RefreshDatabaseWindow
End Sub

[morobaboumar]

Bonsoir hyperion13;
Votre code

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
Private Sub CmdCreerTbl_Mois_Click()
Dim i As Date, j As Date, l As Date, y As Date, k As Integer, m As Integer, z As Integer
 
DoCmd.SetWarnings False
CurrentDb.Execute "CREATE TABLE tblMois_tmp (" _
    & " id_tmp AutoIncrement CONSTRAINT idxid Primary Key, " _
    & " moisdeb_tmp Date, " _
    & " moisfin_tmp Date, " _
    & " numannee_tmp Integer, nummois_tmp Integer, numjour_tmp Integer, " _
    & " CONSTRAINT idxanmois UNIQUE (numannee_tmp, nummois_tmp))", dbFailOnError
 
i = Me.txtmoisdeb
j = Me.txtmoisfin
k = DateDiff("m", DateSerial(Year(i), Month(i), 1), DateSerial(Year(j), Month(j), 1))
 
For z = 0 To k
    l = DateAdd("m", z, i)
    CurrentDb.Execute "INSERT INTO tblMois_tmp (moisdeb_tmp, moisfin_tmp, numannee_tmp, nummois_tmp, numjour_tmp)" _
    & " VALUES (#" & Format(l, "mm/dd/yyyy") & "#, #" & DateSerial(Year(l), Month(l) + 1, 0) & "#, " & Year(l) & ", " & Month(l) & ", " & Day(DateSerial(Year(l), Month(l) + 1, 0)) & ")", dbFailOnError
Next z
    CurrentDb.Execute "INSERT INTO tblMois (moisdeb, moisfin, numannee, nummois, numjour)" _
    & " SELECT moisdeb_tmp, moisfin_tmp, numannee_tmp, nummois_tmp, numjour_tmp" _
    & " FROM tblMois_tmp" _
    & " WHERE moisdeb_tmp Not In (SELECT moisdeb FROM tblMois)", dbFailOnError
DoCmd.DeleteObject acTable, "tblMois_tmp"
DoCmd.SetWarnings True
RefreshDatabaseWindow
End Sub

se comporte presque de la même manière que le mien

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
 
Private Sub GenererTableMois()
On Error GoTo OUMAR
Dim strMois As String
Dim strAnnee As String
Dim X As Integer
Dim i As Integer
Dim j As Integer
 
DoCmd.SetWarnings False
 
DoCmd.RunSQL "delete * from tmois;"
j = 1
DoEvents
For i = -Me.X To Me.Y
strMois = CStr(UCase(MonthName(Month(DateAdd("m", i, date))) & " " & Year(DateAdd("m", i, date))))
strAnnee = Year(DateAdd("m", i, date))
DoCmd.RunSQL "insert into tmois(LibMois,id,Annee_tMois) values ('" & strMois & "'," & j & ",'" & strAnnee & "');"
j = j + 1
'Me.cptantpour.AddItem UCase(MonthName(Month(DateAdd("m", i, date))) & " " & Year(DateAdd("m", i, date)))
Next i
DoCmd.SetWarnings True
 
Exit Sub
OUMAR:
    MsgBox "Erreur n° " & err.Number & vbCrLf & err.description, vbCritical + vbOKOnly, "Une erreur est survenue"
End Sub

Je vous signale que j'ai ajouter un nouveau champ à la table "tblMois" qui est remplie à votre code.



Comment dois je adapter votre code avec le nouveau champ LibMois que j'ai créé et devrais contenir par exemple Janvier 2019; Février 2019.
Cordialement.

[hyperion13]

Désolé, mais je ne vois pas l'intérêt de transformer une date en type texte !

[morobaboumar]

Bonsoir hyperion13 !
Message compris.
Merci infiniment.