Discussion :

[Titatu]

Bonjour à tous,

J'aimerais écrire un programme permettant d'automatiser le groupement de codes postaux en zones en suivant certains critères. Je pense avoir un algorithme potable, mais étant débutante il me manque malheureusement la traduction en langage VBA... J'ai quand même fait une tentative qui bien sûr ne fonctionne pas, je m'explique :

J'ai une table sur laquelle tous mes calculs sont basés = DonneesCP. Elle regroupe les champs :
- Codes Postaux = CP (texte)
- Longitude en mètres = X (réel double)
- Latitude en mètres = Y (réel doube)
- Surface = ha_MT_RGA (réel double)
- Nombre d'individus = nb_MT_RGA (entier long)
- Distance (réel double) / Vide au départ
- Attribution (T/F) / Vide au départ
- Zone (entier long) / Vide au départ

Mon objectif est de créer une zone en ajoutant les codes postaux de proche en proche jusqu'à ce que la zone atteigne une surface ou un nombre d'individus donné.
Pour cela je procède en deux étapes, voici mon 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
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
 
Private Sub Commande0_Click()
'Commande0 = un bouton pour déclencher la procédure. Le formulaire sera plus élaboré plus tard...
 
'Appels
 
Dim MAJDistance_CP_SQL As String, MAJAttribution_CP_SQL As String, MAJZone_CP_SQL As String
 
Dim CPini As String, Xini As Double, Yini As Double
Dim NbEnregistrements As Integer, i As Integer
Dim X As Double, Y As Double
Dim Distance As Double
 
Dim NumZone As Integer
Dim Smt As Double, Smtmax As Double
Dim Nbmt As Integer, Nbmtmax As Integer
Dim Distancemin As Double
 
'1. Calcul de la distance de chaque CP au CP initial
 
CPini = "'" & InputBox("Code postal de départ :") & "'"
Xini = DLookup("[DonneesCP].[X]", "[DonneesCP]", "[DonneesCP].[CP] = '" & CPini & "'") 'Erreur de syntaxe : opérateur absent dans [DonneesCP].[CP] = "11090"
Yini = DLookup("[DonneesCP].[Y]", "[DonneesCP]", "[DonneesCP].[CP] = '" & CPini & "'")
 
NbEnregistrements = DCount("[DonneesCP].[CP]", "[DonneesCP]")
 
'Calcul pour chaque enregistrement
For i = 1 To NbEnregistrements
 
    X = [DonneesCP].[X](i) 'Syntaxe fausse très certainement, je cherche à récupérer le X de l'enregistrement i
    Y = [DonneesCP].[Y](i)
 
    ' Calcul de la distance : petit Pythagore...
    Distance = ((Xini - X) ^ 2 + (Yini - Y) ^ 2) ^ (1 / 2)
 
    ' MAJ du champ Distance de l'enregistrement i
    MAJDistance_CP_SQL = "UPDATE [DonneesCP] SET [DonneesCP].[Distance] = Distance" & _
                "WHERE [DonneesCP].[CP] = [DonneesCP].[CP](i)"
    DoCmd.RunSQL MAJDistance_CP_SQL, dbFailOnError
 
Next i
 
'2. Calcul de la Zone 1
 
NumZone = 1
 
Smtmax = InputBox("Surface zone :")
Nbmtmax = InputBox("Effectif de la zone :")
 
Smt = DLookup("[DonneesCP].[ha_MT_RGA]", "[DonneesCP]", "[DonneesCP].[CP] = '" & CPini & "'")
Nbmt = DLookup("[DonneesCP].[nb_MT_RGA]", "[DonneesCP]", "[DonneesCP].[CP] = '" & CPini & "'")
 
Do While Smt <= Smtmax And Nbmt <= Nbmtmax
 
    Distancemin = DMin("[DonneesCP].[Distance]", "[DonneesCP]", "[Donnees].[Attribution] <> TRUE")
 
    MAJAttribution_CP_SQL = "UPDATE [DonneesCP] SET [DonneesCP].[Attribution] = TRUE" & _
                "WHERE [DonneesCP].[Distance]= Distancemin"
    DoCmd.RunSQL MAJAttribution_CP_SQL, dbFailOnError
 
    MAJZone_CP_SQL = "UPDATE [DonneesCP] SET [DonneesCP].[Zone] = NumZone" & _
                "WHERE [DonneesCP].[Distance]= Distancemin"
    DoCmd.RunSQL MAJZone_CP_SQL, dbFailOnError
 
    Smt = Smt + DLookup("[DonneesCP].[ha_MT_RGA]", "[DonneesCP]", "[DonneesCP].[Distance] = Distancemin")
    Nbmt = Nbmt + DLookup("[DonneesCP].[nb_MT_RGA]", "[DonneesCP]", "[DonneesCP].[Distance] = Distancemin")
 
Loop
 
End Sub

J'ai donc besoin de votre aide pour appliquer à ce code un langage VBA correct... Merci d'avance !

[helas]

Bonjour,
Effectivement ce n'est pas bon
Remplacer la boucle For par ceci:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
 Dim t As DAO.Recordset
 Set t = CurrentDb.OpenRecordset("DonneesCP")
 Do Until t.EOF
    x = t!x
    y = t!y
 
 .......................
 
    t.MoveNext
 Loop
 t.Close

Ouverture de la table
lecture des données pour chaque enregistrement
t.EOF = plus d'enregistrement
Fermeture de la table

[Titatu]

Super, merci pour ta réponse.
Je ne peux malheureusement pas faire tourner la boucle car le début de mon code n'est pas fonctionnel... Sais-tu d'où vient le message d'erreur pour Dlookup ? J'ai eu beau chercher sur le net toutes les formules suivent le même modèle que la mienne.

Penses-tu également que j'ai d'autres erreurs de langage dans le reste du code ?