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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
| Private Sub Commande105_Click()
'prepare le fichier excel pour l'import de retriever et numérote les bracelets
Dim myconnection As ADODB.Connection
Set myconnection = CurrentProject.Connection
Dim myRecordset As New ADODB.Recordset
myRecordset.ActiveConnection = myconnection
Dim Derbrac As String
Dim DerbracRec As String
Dim SAISON As Integer
Dim Mysql As String
Dim CompteSiBrac As Integer
Dim T As Integer
Dim Reponse As String
Dim Chemin As String
Dim CheminCSV As String
SAISON = Me.Te_Saison
Reponse = MsgBox("vous allez généré des numéros de bracelet. es-ce des bracelets d'attribution INITIALE? Si oui, cliquez OUI; si c'est des recours cliquez NON.", vbYesNoCancel)
If Reponse = Cancel Then
Exit Sub
End If
'trouve le dernier bracelet utilisé
Derbrac = DMax("PDC_BRACELETFIN", "[Table_Attribution_PG_Lievre]", "Not IsNull(PDC_BRACELETFIN) And (saison) = " & SAISON & "")
DerbracRec = Nz(DMax("PDC_BRACELETFINRECOURS", "[Table_Attribution_PG_Lievre]", "Not IsNull(PDC_BRACELETFINRECOURS) And (saison) = " & SAISON & ""), 0)
'le bracelet utilisable maintenant
'compte si il y a deja des brac
CompteSiBrac = DCount("PDC_BRACELETFIN", "[Table_Attribution_PG_Lievre]", "Not IsNull(PDC_BRACELETFIN) And (saison) = " & SAISON & "")
CompteSiBracRec = DCount("PDC_BRACELETFINRECOURS", "[Table_Attribution_PG_Lievre]", "Not IsNull(PDC_BRACELETFINRECOURS) And (saison) = " & SAISON & "")
If IsNull(CompteSiBrac) Or CompteSiBrac = 0 Then
Derbrac = 0
Else
Derbrac = Derbrac + 1
End If
If IsNull(CompteSiBracRec) Or CompteSiBracRec = 0 Then
DerbracRec = 0
Else
DerbracRec = DerbracRec + 1
End If
'supprime la table si elle existe
SupprimerTable ("Table_PourImport_Retriever_temp")
'importe dans la Table_PourImport_Retriever_temp les données du fichier PourExport.xlsx
DoCmd.TransferSpreadsheet acImport, 8, "Table_PourImport_Retriever_temp", "T:\Nivalis\Lièvre\PourExport.xlsx", True, "A:K"
'ajout de champs dans la table Table_PourImport_Retriever_temp
Mysql = "alter table Table_PourImport_Retriever_temp ADD COLUMN Bracelet_deb Long, COLUMN Bracelet_fin Long, COLUMN bracc text(15);"
CurrentDb.Execute Mysql
'numerote dans la table
Mysql = " SELECT Table_PourImport_Retriever_temp.MATRICULE_EXCEL, Table_PourImport_Retriever_temp.PDC_PROPOSITION, Table_PourImport_Retriever_temp.Bracelet_deb, Table_PourImport_Retriever_temp.Bracelet_fin, Table_PourImport_Retriever_temp.bracc " & _
" FROM Table_PourImport_Retriever_temp;"
' éxecute la requete
myRecordset.Open Mysql, , adOpenStatic
' positionne sur la premiere ligne
myRecordset.MoveFirst
' compte le nombre d'enregistrement
T = myRecordset.RecordCount
If Reponse = vbYes Then
numero_bracelet = Derbrac
End If
If Reponse = vbNo Then
numero_bracelet = DerbracRec
End If
For I = 1 To T
If Nz(myRecordset.Fields(1), 0) > 0 Then
numero_bracelet = numero_bracelet + 1
numero_braceletfin = myRecordset.Fields(1) + numero_bracelet - 1
Mysql = " UPDATE Table_PourImport_Retriever_temp SET Table_PourImport_Retriever_temp.Bracelet_deb =" & numero_bracelet & ", Table_PourImport_Retriever_temp.Bracelet_fin =" & numero_braceletfin & _
" WHERE (((Table_PourImport_Retriever_temp.MATRICULE_EXCEL)='" & myRecordset.Fields(0) & "'));"
CurrentDb.Execute Mysql
numero_bracelet = numero_braceletfin
Else
End If
myRecordset.MoveNext
Next I
myRecordset.Close
'supprime la requete si elle existe
SupprimerRequete ("Re_PourImport_Brac_LI_Temp")
'Créer la requete pour l'export
'################################
Mysql = " SELECT Table_PourImport_Retriever_temp.MATRICULE_EXCEL, Table_PourImport_Retriever_temp.PDC_PROPOSITION, IIf([PDC_PROPOSITION]=0,'""',[Bracelet_deb] & '" - "' & [Bracelet_fin]) AS bracc " & _
" FROM Table_PourImport_Retriever_temp " & _
" GROUP BY Table_PourImport_Retriever_temp.MATRICULE_EXCEL, Table_PourImport_Retriever_temp.PDC_PROPOSITION, IIf([PDC_PROPOSITION]=0,'""', [Bracelet_deb] & '" - "' & [Bracelet_fin]), " & _
" Table_PourImport_Retriever_temp.TERRITOIRE_BASE, Table_PourImport_Retriever_temp.Bracelet_deb, Table_PourImport_Retriever_temp.Bracelet_fin " & _
" ORDER BY Table_PourImport_Retriever_temp.TERRITOIRE_BASE;"
CurrentDb.CreateQueryDef "Re_PourImport_Brac_LI_Temp", Mysql
'transfert en format xls et dos
'definition des chemins
If Reponse = vbYes Then
'export vers le fichier excel
Chemin = "T:\NIVALIS\Lièvre\" & SAISON & "\BraceletLievre" & SAISON & "_" & Month(Now) & "_" & Day(Now) & ".xls"
CheminCSV = "T:\NIVALIS\Lièvre\" & SAISON & "\BraceletLievre" & SAISON & "_" & Month(Now) & "_" & Day(Now) & ".CSV"
End If
If Reponse = vbNo Then
'export vers le fichier excel
Chemin = "T:\NIVALIS\Lièvre\" & SAISON & "\BraceletLievreREC" & SAISON & "_" & Month(Now) & "_" & Day(Now) & ".xls"
CheminCSV = "T:\NIVALIS\Lièvre\" & SAISON & "\BraceletLievreREC" & SAISON & "_" & Month(Now) & "_" & Day(Now) & ".CSV"
End If
'export
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "Re_PourImport_Brac_LI_Temp", Chemin
SupprimerRequete ("Re_PourImport_Brac_LI_Temp")
MsgBox ("Votre fichier a soumettre a retriever se trouve : " & Chemin) |
