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
| Private Sub Commande5_Click()
Dim fl As Integer
Dim SQL As String
Dim db As dao.Database, rst As dao.Recordset, fld As dao.Field, rst1 As dao.Recordset, rst2 As dao.Recordset
Dim sSQL As String
Dim sSQL1 As String
Dim sSQL2 As String
Dim donne As String
Set db = CurrentDb()
sSQL1 = "SELECT distinct societe FROM colonne"
sSQL2 = "SELECT * FROM colonne"
Set rst1 = db.OpenRecordset(sSQL1)
Set rst2 = db.OpenRecordset(sSQL2)
rst1.MoveFirst
fl = FreeFile()
Open "c:\Monfichier1.txt" For Output As #fl
aff_colonne = "societe;adresse;domaine"
k = 3
While k < rst2.Fields.Count
val_col = "nom_responsable" & (k - 3) & ";" & "fonction_Responsable" & (k - 3) & ";" & "tel1_responsable" & (k - 3) & ";" & "tel2_responsable" & (k - 3) & ";" & "tel3_responsable" & (k - 3) & ";" & "Fax_responsable" & (k - 3) & ";" & "Adresse mail responsable" & (k - 3) & ";"
k = k + 1
recup_col = recup_col & val_col
val_col = ""
Wend
colonnes = aff_colonne & ";" & recup_col
Print #fl, colonnes
rst2.Close
While Not rst1.EOF
n = 0
While n < rst1.Fields.Count 'selection de valeur1 qui va être appliqué comme filtre de regroupement
valeur1 = rst1.Fields(n).Value
sSQL = "SELECT * FROM colonne WHERE societe =" & "'" & valeur1 & "'"
Set rst = db.OpenRecordset(sSQL)
rst.MoveFirst
While Not rst.EOF 'parcourir les lignes
j = 3
While j < rst.Fields.Count
var_champ = rst.Fields(j).Value
If IsNutot_lignes(var_champ) Then
donne = ""
Else
donne = var_champ & ";"
End If
j = j + 1
cap_champ = cap_champ & donne 'additionner les champs
Wend
rst.MoveNext
champs_lignes = champs_lignes & cap_champ 'additionner les lignes champs
donne = ""
cap_champ = "" 'reinitialiser les variable de capture
Wend
rst.MoveFirst
n = n + 1
tot_lignes = rst.Fields(0).Value & ";" & rst.Fields(1).Value & ";" & rst.Fields(2).Value & ";" & champs_lignes 'stocker la ligne
Wend
rst1.MoveNext 'passer au filtre suivant
Print #fl, tot_lignes 'ecrire dans le fichier text
rst.Close
tot_lignes = ""
champs_lignes = "" 'reinitialisation
Wend
rst1.Close
If fl <> 0 Then Close #fl
End Sub |
Partager