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
| Private Sub macro_map()
Dim dbs As Database
Dim rst1 As Recordset
Dim rep_base As String
Dim oFSO As Scripting.FileSystemObject
Dim oFl As Scripting.File
Dim oTxt As Scripting.TextStream
Dim i, j As Integer
Dim machaine, tablo(344, 2) As String
Dim lhProcess As Long
Dim lProcessID As Long
Dim lpExitCode As Long
Set oFSO = New Scripting.FileSystemObject
Set dbs = CurrentDb
Set rst1 = dbs.OpenRecordset("SELECT * FROM CONFIG WHERE CONFIG.TypeDonnee='Répertoire contenant les images';")
If Not (rst1.EOF) Then
rst1.MoveFirst
rep_base = rst1!Donnee
rst1.Close
'******************** li dans le fichier data.src *********************
Set oFl = oFSO.GetFile(rep_base & "\data\data.src")
Set oTxt = oFl.OpenAsTextStream(ForReading)
i = 0
With oTxt
While (Not .AtEndOfStream And i < 344)
i = i + 1
machaine = .ReadLine
tablo(i, 1) = Left(machaine, InStr(machaine, vbTab) - 1)
tablo(i, 2) = Right(machaine, Len(machaine) - InStr(machaine, vbTab))
Wend
j = i
End With
oTxt.Close
Set oFl = Nothing
'******************** lance la requête (cherchez pas à la comprendre je vous donne le fichier résultat juste après) ********************************
Set rst1 = dbs.OpenRecordset("select insee, ville, d_min FROM (SELECT COMMUNE.insee, COMMUNE.Nom AS Ville, MIN(DISTANCE.km+CATEGCS.DistSup) AS D_Min FROM (FAMTE INNER JOIN TYPENGIN ON FAMTE.Libelle = TYPENGIN.Famille) INNER JOIN (((CATEGCS INNER JOIN CS ON CATEGCS.ProVol = CS.ProVol) INNER JOIN ARME ON CS.Nom = ARME.ArmeCS) INNER JOIN (COMMUNE INNER JOIN DISTANCE ON COMMUNE.INSEE = DISTANCE.DistCOM) ON CS.Nom = DISTANCE.DistCS) ON TYPENGIN.Libelle = ARME.ArmeTE WHERE (((FAMTE.Libelle) = 'FPT')) GROUP BY COMMUNE.insee,COMMUNE.Nom ORDER BY COMMUNE.Nom) ;")
Set oFl = oFSO.GetFile(rep_base & "\data\carte.src")
Set oTxt = oFl.OpenAsTextStream(ForWriting)
rst1.MoveFirst
i = 0
'******************** écris dans le fichier carte.src ******************
oTxt.WriteLine "#" & vbTab & "iden" & vbTab & "commune" & vbTab & "nouvelle_couleur"
While Not (rst1.EOF)
i = i + 1
With oTxt
If (rst1!D_Min <= 10) Then
.WriteLine i & vbTab & rst1!INSEE & vbTab & rst1!Ville & vbTab & "FF7700"
Else
If (rst1!D_Min <= 20) Then
.WriteLine i & vbTab & rst1!INSEE & vbTab & rst1!Ville & vbTab & "77FF00"
Else
If (rst1!D_Min <= 30) Then
.WriteLine i & vbTab & rst1!INSEE & vbTab & rst1!Ville & vbTab & "00FF77"
Else
If (rst1!D_Min <= 45) Then
.WriteLine i & vbTab & rst1!INSEE & vbTab & rst1!Ville & vbTab & "0077FF"
Else
.WriteLine i & vbTab & rst1!INSEE & vbTab & rst1!Ville & vbTab & "000000"
End If
End If
End If
End If
End With
rst1.MoveNext
Wend
oTxt.Close
Set oFSO = Nothing
rst1.Close
End If
dbs.Close
' coller également le code de modification de l'image ici
End Sub |
Partager