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 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216
|
Option Compare Database
Option Explicit
Public SQL As String
Private Sub chkcommune_Click()
If Me.chkcommune Then
Me.cmbcommune.Visible = False
Else
Me.cmbcommune.Visible = True
End If
RefreshQuery
End Sub
Private Sub chkinsee_Click()
If Me.chkinsee Then
Me.txtinsee.Visible = False
Else
Me.txtinsee.Visible = True
End If
RefreshQuery
End Sub
Private Sub chkparcelle_Click()
If Me.chkparcelle Then
Me.txtparcelle.Visible = False
Else
Me.txtparcelle.Visible = True
End If
RefreshQuery
End Sub
Private Sub chklieudit_Click()
If Me.chklieudit Then
Me.txtlieudit.Visible = False
Else
Me.txtlieudit.Visible = True
End If
RefreshQuery
End Sub
Private Sub chksuperficie_Click()
If Me.chksuperficie Then
Me.txtsuperficie.Visible = False
Else
Me.txtsuperficie.Visible = True
End If
RefreshQuery
End Sub
Private Sub chknaturecadastrale_Click()
If Me.chknaturecadastrale Then
Me.txtnaturecadastrale.Visible = False
Else
Me.txtnaturecadastrale.Visible = True
End If
RefreshQuery
End Sub
Private Sub cmbcommune_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
Private Sub txtinsee_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
Private Sub txtlieudit_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
Private Sub txtparcelle_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
Private Sub txtsuperficie_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
Private Sub txtnaturecadastrale_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
Private Sub Form_Load()
Dim ctl As Control
For Each ctl In Me.Controls
Select Case Left(ctl.Name, 3)
Case "chk"
ctl.Value = -1
Case "lbl"
ctl.Caption = "- * - * -"
Case "txt"
ctl.Visible = False
ctl.Value = ""
Case "cmb"
ctl.Visible = False
End Select
Next ctl
Me.lstResults.RowSource = "SELECT OBJECTID, COMMUNE, INSEE, LIEU_DIT, N_PARC, SURF_TOT, NAT_CAD_CU FROM Propriétés_cg74_2005;"
Me.lstResults.Requery
End Sub
Private Sub RefreshQuery()
Dim SQL As String
Dim SQLWhere As String
SQL = "SELECT OBJECTID, COMMUNE, INSEE, LIEU_DIT, N_PARC, SURF_TOT, NAT_CAD_CU FROM Propriétés_cg74_2005 Where Propriétés_cg74_2005!OBJECTID <> 0 "
If Not Me.chkcommune Then
SQL = SQL & "And Propriétés_cg74_2005!COMMUNE = '" & Me.cmbcommune & "' "
End If
If Not Me.chkinsee Then
SQL = SQL & "And Propriétés_cg74_2005!INSEE like '*" & Me.txtinsee & "*' "
End If
If Not Me.chklieudit Then
SQL = SQL & "And Propriétés_cg74_2005!LIEU_DIT like '*" & Me.txtlieudit & "*' "
End If
If Not Me.chkparcelle Then
SQL = SQL & "And Propriétés_cg74_2005!N_PARC like '*" & Me.txtparcelle & "*' "
End If
If Not Me.chksuperficie Then
SQL = SQL & "And Propriétés_cg74_2005!SURF_TOT = '" & Me.txtsuperficie & "' "
End If
If Not Me.chknaturecadastrale Then
SQL = SQL & "And Propriétés_cg74_2005!NAT_CAD_CU like '*" & Me.txtnaturecadastrale & "*' "
End If
SQLWhere = Trim(Right(SQL, Len(SQL) - InStr(SQL, "Where ") - Len("Where ") + 1))
SQL = SQL & ";"
Me.lblStats.Caption = DCount("*", "Propriétés_cg74_2005", SQLWhere) & " / " & DCount("*", "Propriétés_cg74_2005")
Me.lstResults.RowSource = SQL
Me.lstResults.Requery
End Sub
Private Sub Commande5_Click()
If Nz(txtChemin, "") = "" Then
MsgBox "Sélectionner une destination"
Else
'Exporter
Dim db As Database
Dim qd As QueryDef
Set db = CurrentDb()
Set qd = db.CreateQueryDef("export_excel", SQL)
qd.Close
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "export_excel", txtChemin, True
DoCmd.DeleteObject acExport, "export_excel"
End If
End Sub
Private Sub chkexcel_Click()
If Me.chkexcel Then
Me.txtChemin.Visible = False
Else
Me.txtChemin.Visible = True
End If
RefreshQuery
End Sub
Private Sub lstResults_DblClick(Cancel As Integer)
DoCmd.OpenForm "Edition", acNormal, , "[OBJECTID] = " & Me.lstResults
End Sub |
Partager