VB6 Mettre un bouton en avant plan
Résolu
cs_JeffC1977
Messages postés
928
Date d'inscription
vendredi 10 novembre 2000
Statut
Membre
Dernière intervention
23 septembre 2023
-
25 août 2005 à 21:01
cs_JeffC1977 Messages postés 928 Date d'inscription vendredi 10 novembre 2000 Statut Membre Dernière intervention 23 septembre 2023 - 26 août 2005 à 16:06
cs_JeffC1977 Messages postés 928 Date d'inscription vendredi 10 novembre 2000 Statut Membre Dernière intervention 23 septembre 2023 - 26 août 2005 à 16:06
13 réponses
violent_ken
Messages postés
1812
Date d'inscription
mardi 31 mai 2005
Statut
Membre
Dernière intervention
26 octobre 2010
2
26 août 2005 à 15:55
26 août 2005 à 15:55
Alors voilà ce que je te propose :
1) coupe le controle frmparoisse
2) colle le controle frmparoisse dans ta form (ne le colle pas sur un autre controle) ==> ta frame apparait en haut à gauche de l'écran
3) repositionne frmparoisse en la déplaçant (ne coupe/colle pas)
4) coupe cmdretour
5) colle cmdretour dans ta form (ne le colle pas sur un autre controle) ==> cmdretour apparait en haut à gauche de l'écran
6) repositionne cmdretour en le déplaçant (ne coupe/colle pas)
7) voici les modifications à apporter au code :
-ajouter ceci :
Private Sub cmdRetour_Click()
frmParoisse.Visible = True
End Sub
-pour optwexford :
Private Sub optWexford_Click()
cmdRetour.Visible = True
cmdRetour.ZOrder 0
txtRecherche.SetFocus
txtParoisse.Text = "Canton de Wexford"
frmWexford.Left = 90
frmWexford.Top = 1980
frmWexford.Visible = True
frmKilkenny.Visible = False
frmChertsey.Visible = False
frmParoisse.Visible = False
cmdRetour.ZOrder 0
End Sub
-pour optkilkenny :
Private Sub optKilkenny_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Canton de Kilkenny"
frmKilkenny.Visible = True
frmKilkenny.Left = 90
frmKilkenny.Top = 1980
frmChertsey.Visible = False
frmWexford.Visible = False
cmdRetour.Visible = True
frmParoisse.Visible = False
cmdRetour.ZOrder 0
End Sub
-pour chertsey :
Private Sub optChertsey_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Canton de Chertsey"
frmChertsey.Visible = True
frmChertsey.Left = 90
frmChertsey.Top = 1980
frmKilkenny.Visible = False
frmWexford.Visible = False
cmdRetour.Visible = True
frmParoisse.Visible = False
cmdRetour.ZOrder 0
End Sub
Et voilà. Les modifications apportées corrigent le bug !
@+
1) coupe le controle frmparoisse
2) colle le controle frmparoisse dans ta form (ne le colle pas sur un autre controle) ==> ta frame apparait en haut à gauche de l'écran
3) repositionne frmparoisse en la déplaçant (ne coupe/colle pas)
4) coupe cmdretour
5) colle cmdretour dans ta form (ne le colle pas sur un autre controle) ==> cmdretour apparait en haut à gauche de l'écran
6) repositionne cmdretour en le déplaçant (ne coupe/colle pas)
7) voici les modifications à apporter au code :
-ajouter ceci :
Private Sub cmdRetour_Click()
frmParoisse.Visible = True
End Sub
-pour optwexford :
Private Sub optWexford_Click()
cmdRetour.Visible = True
cmdRetour.ZOrder 0
txtRecherche.SetFocus
txtParoisse.Text = "Canton de Wexford"
frmWexford.Left = 90
frmWexford.Top = 1980
frmWexford.Visible = True
frmKilkenny.Visible = False
frmChertsey.Visible = False
frmParoisse.Visible = False
cmdRetour.ZOrder 0
End Sub
-pour optkilkenny :
Private Sub optKilkenny_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Canton de Kilkenny"
frmKilkenny.Visible = True
frmKilkenny.Left = 90
frmKilkenny.Top = 1980
frmChertsey.Visible = False
frmWexford.Visible = False
cmdRetour.Visible = True
frmParoisse.Visible = False
cmdRetour.ZOrder 0
End Sub
-pour chertsey :
Private Sub optChertsey_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Canton de Chertsey"
frmChertsey.Visible = True
frmChertsey.Left = 90
frmChertsey.Top = 1980
frmKilkenny.Visible = False
frmWexford.Visible = False
cmdRetour.Visible = True
frmParoisse.Visible = False
cmdRetour.ZOrder 0
End Sub
Et voilà. Les modifications apportées corrigent le bug !
@+
violent_ken
Messages postés
1812
Date d'inscription
mardi 31 mai 2005
Statut
Membre
Dernière intervention
26 octobre 2010
2
25 août 2005 à 21:28
25 août 2005 à 21:28
Salut !
Tu fait cmdButton.Zorder, et çà te met ton contrôle au premier plan. (le bouton passera dessus le frame, sans qu'il ne soit dedans)
Si çà répond à ta question ,clique sur "réponse acceptée" !
@+
Tu fait cmdButton.Zorder, et çà te met ton contrôle au premier plan. (le bouton passera dessus le frame, sans qu'il ne soit dedans)
Si çà répond à ta question ,clique sur "réponse acceptée" !
@+
cs_JeffC1977
Messages postés
928
Date d'inscription
vendredi 10 novembre 2000
Statut
Membre
Dernière intervention
23 septembre 2023
4
25 août 2005 à 21:45
25 août 2005 à 21:45
Salut j'ai essayé et ca ne fonctionne pas....
je l'ai mit dans mon optButton
Private Sub optWexford_Click()
cmdRetour.ZOrder
cmdRetour.Visible = True
txtRecherche.SetFocus
txtParoisse.Text = "Canton de Wexford"
frmWexford.Left = 90
frmWexford.Top = 1980
frmWexford.Visible = True
frmKilkenny.Visible = False
frmChertsey.Visible = False
End Sub
Et je ne vois rien...
J'ai essayé de le mettre dans mon Load_Form et ca ne fonctionne pas non plus....
Je ne sais pas si le problème eput venir que lorsque je démare le programme le Button est invisble... J'attends de tes nouvelles...
je l'ai mit dans mon optButton
Private Sub optWexford_Click()
cmdRetour.ZOrder
cmdRetour.Visible = True
txtRecherche.SetFocus
txtParoisse.Text = "Canton de Wexford"
frmWexford.Left = 90
frmWexford.Top = 1980
frmWexford.Visible = True
frmKilkenny.Visible = False
frmChertsey.Visible = False
End Sub
Et je ne vois rien...
J'ai essayé de le mettre dans mon Load_Form et ca ne fonctionne pas non plus....
Je ne sais pas si le problème eput venir que lorsque je démare le programme le Button est invisble... J'attends de tes nouvelles...
MaDzA
Messages postés
20
Date d'inscription
mercredi 18 mai 2005
Statut
Membre
Dernière intervention
13 septembre 2005
1
25 août 2005 à 22:18
25 août 2005 à 22:18
Fais un clique droit sur ton composant et sélectionne "mettre au premier plan"
voilà j'espère que sa répond à ta question!
a++
voilà j'espère que sa répond à ta question!
a++
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
cs_CanisLupus
Messages postés
3757
Date d'inscription
mardi 23 septembre 2003
Statut
Membre
Dernière intervention
13 mars 2006
20
25 août 2005 à 22:18
25 août 2005 à 22:18
Salut,
Essaie cmdRetour.ZOrder 0
Ca mettra ton button au dessus de la pile donc devant tous les autres.
-------------------------------------------------
Dresseur de puces, .... normal pour un loup !?
Essaie cmdRetour.ZOrder 0
Ca mettra ton button au dessus de la pile donc devant tous les autres.
-------------------------------------------------
Dresseur de puces, .... normal pour un loup !?
cs_JeffC1977
Messages postés
928
Date d'inscription
vendredi 10 novembre 2000
Statut
Membre
Dernière intervention
23 septembre 2023
4
25 août 2005 à 22:29
25 août 2005 à 22:29
Ca fonctionne toujours pas.....
:(...
Si tu as une autre idée
merci d'avance
:(...
Si tu as une autre idée
merci d'avance
Zlub
Messages postés
809
Date d'inscription
mercredi 11 octobre 2000
Statut
Membre
Dernière intervention
29 septembre 2010
8
26 août 2005 à 01:17
26 août 2005 à 01:17
Salut,
essais
Frame.ZOrder (1)
cmdRetour.ZOrder (0)
++
Zlub
essais
Frame.ZOrder (1)
cmdRetour.ZOrder (0)
++
Zlub
violent_ken
Messages postés
1812
Date d'inscription
mardi 31 mai 2005
Statut
Membre
Dernière intervention
26 octobre 2010
2
26 août 2005 à 09:51
26 août 2005 à 09:51
Salut !
Peux tu me détailler (dans ton code) quel bouton doit apparaître dessus quel frame ?
Est-ce cmdRetour qui doit apparaître dessus frmWexford ?
Peux tu me décrire où sont placés tes éléments dans ta form ? Et à quel état (visible ou non) sont tes controles au "loading" de ta form ?
@+
Peux tu me détailler (dans ton code) quel bouton doit apparaître dessus quel frame ?
Est-ce cmdRetour qui doit apparaître dessus frmWexford ?
Peux tu me décrire où sont placés tes éléments dans ta form ? Et à quel état (visible ou non) sont tes controles au "loading" de ta form ?
@+
violent_ken
Messages postés
1812
Date d'inscription
mardi 31 mai 2005
Statut
Membre
Dernière intervention
26 octobre 2010
2
26 août 2005 à 10:31
26 août 2005 à 10:31
Meilleure idée : ouvre ta form avec le bloc notes, et envoie le code entier.
Et précise aussi quel bouton doit apparaître au dessus de quel frame.
@+
Et précise aussi quel bouton doit apparaître au dessus de quel frame.
@+
cs_JeffC1977
Messages postés
928
Date d'inscription
vendredi 10 novembre 2000
Statut
Membre
Dernière intervention
23 septembre 2023
4
26 août 2005 à 14:04
26 août 2005 à 14:04
Salut... Alors mon Bouton Retour doit etre en premier plan lorsque je clique sur optChertsey ou optKilkenny ou optWexford
sinon on ne le voit pas.....
Mes 3 frames frmKilenny, frm Chertsey et frm Wexford sont tous placé au départ à côté du frame principale (frmParoisse). Donc quand je fais un clique sur, par exemple optChertsey alors le frame se déplace au bon endroit (sur le frmParoisse) et devrait faire apparaite le bouton Retour par dessus ces frames...
Voici le code en entier....
merci d'avance
Option Explicit
Dim Connection As New ADODB.Connection
Dim BD As New ADODB.Recordset
Dim BD2 As New ADODB.Recordset
Dim strRechercheFolio As Integer
Dim OuvertureTIF As Variant
'Variable pour la boulce
'*******************************
Dim strBoucle As Integer '*
Dim Repertoire As String '*
Dim Fichier As String '*
'*******************************
' Cette déclaration est utilisée afin de faire fonctionner le ShellExecute
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'Est utilisé pour fermer le programme
Dim F As Form
For Each F In Forms
Unload F
Next
End Sub
Private Sub Form_Load()
'Type de bases de donnée pour la connexion (Pour Acces 2000 (4.0), pour la version 95 et 97 (3.51)
Connection.Provider = "Microsoft.jet.OLEDB.4.0"
'Chemin de la base de donnée (APP.PATH permet de ce mettre dans le chemin
'courant la ou ce trouve le projet)- Paramettrage de la chaine de connection
Connection.ConnectionString = App.Path & "\FOLIO_RENO.mdb"
'Ouverture de la connection
Connection.Open
'Ouverture de la requête sql dans le recordset
BD.Open "Select * from FOLIO_CADASTRE", Connection, adOpenDynamic, adLockOptimistic
Me.Show
txtRecherche.SetFocus
End Sub
'Est utiliser afin de faire fonctionner la Recherche SQL du Bouton Recherche
'le TXTVersSQL format le text en SQL
Function TXTVersSQL(message As String) As String
message = Replace(message, "'", "''")
TXTVersSQL = "'" & message & "'"
End Function
Private Sub cmdRecherche_Click()
Dim supression As Variant
If optAlexis.Value False And optEsprit.Value False And optJacques.Value = False And optJulienne.Value = False And optSalome.Value = False And optChertsey.Value = False And optKilkenny.Value = False And optWexford.Value = False Then
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Faire une Sélection!"
GoTo Absent
End If
'***************************************************************************************************
'PAROISSE
If optAlexis.Value True Or optEsprit.Value True Or optJacques.Value = True Or optJulienne.Value = True Or optSalome.Value = True Then
Set BD2 = New ADODB.Recordset
BD2.Open "SELECT * FROM [FOLIO_CADASTRE] WHERE [cad] = " & TXTVersSQL(txtRecherche.Text) & " AND [nomcad] = " & TXTVersSQL(txtParoisse.Text), Connection, adOpenKeyset, adLockBatchOptimistic
'BD2.Open "SELECT * FROM [FOLIO_CADASTRE] WHERE [cad] like '" & txtRecherche.Text & "' AND [nomcad] like '" & txtParoisse.Text & "'", Connection, adOpenKeyset, adLockBatchOptimistic
'BD2.Open "SELECT * FROM [GES_TEMPS] WHERE [DOSSIER] like '%" & txtRecherche.Text & "%' AND [EMPLOYER] like '" & ListTempsEmployesRecherche.Text & "'", Connection, adOpenKeyset, adLockBatchOptimistic
'Where cad Like '1' renverra lenregistrement qui contient le caractère 1
'Where cad Like '%1%' renverra tous les enregistrements qui contiennent le caractère 1
'Where cad Like '1%' renverra tous les enregistrements qui commencent par le caractère 1
'Where cad Like '%1' renverra tous les enregistrements qui finissent par le caractère 1
'Code qu'il y avait auparavant
'BD2.Open "SELECT * FROM [FOLIO_CADASTRE] WHERE [cad] like '%" & txtRecherche.Text & "'%", Connection, adOpenKeyset, adLockBatchOptimistic
If BD2.RecordCount <> 0 Then
txtFolio.Text = BD2!folio & ""
txtLot.Text = BD2!cad & ""
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Lot Absent!"
GoTo Absent
End If
If optJulienne.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\STE-JULIENNE"
If txtFolio < 1000 Then
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1680_0" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
Else
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1680_" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
End If
If optAlexis.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\ST-ALEXIS"
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1640_0" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
End If
If optEsprit.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\SAINT-ESPRIT"
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1660_0" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
If optJacques.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\ST-JACQUES"
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1610_0" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
If optSalome.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\STE-MARIE-SALOME"
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1600_0" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
'****************************************************************************************************»
If optChertsey.Value True Or optKilkenny.Value True Or optWexford.Value = True Then
'****************************************************************************************************»
'CANTON
Set BD2 = New ADODB.Recordset
BD2.Open "SELECT * FROM [FOLIO_CADASTRE] WHERE [cad] like '" & txtRecherche.Text & "%' AND [dessec] like '%" & txtRang.Text & "%'", Connection, adOpenKeyset, adLockBatchOptimistic
'BD2.Open "SELECT * FROM [GES_TEMPS] WHERE [DOSSIER] like '%" & txtRecherche.Text & "%' AND [EMPLOYER] like '%" & ListTempsEmployesRecherche.Text & "%'", Connection, adOpenKeyset, adLockBatchOptimistic
'Where cad Like '1' renverra lenregistrement qui contient le caractère 1
'Where cad Like '%1%' renverra tous les enregistrements qui contiennent le caractère 1
'Where cad Like '1%' renverra tous les enregistrements qui commencent par le caractère 1
'Where cad Like '%1' renverra tous les enregistrements qui finissent par le caractère 1
'Code qu'il y avait auparavant
'BD2.Open "SELECT * FROM [FOLIO_CADASTRE] WHERE [cad] like '%" & txtRecherche.Text & "'%", Connection, adOpenKeyset, adLockBatchOptimistic
If BD2.RecordCount <> 0 Then
txtFolio.Text = BD2!folio & ""
txtLot.Text = BD2!cad & ""
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Lot Absent!"
GoTo Absent
End If
If optKilkenny.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\Kilkenny"
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
If optChertsey.Value = True Then
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Plan non numérisé!"
End If
End If
txtRecherche.SetFocus
Absent:
txtRecherche.SetFocus
End Sub
Private Sub form_Activate()
'Chargement des textbox a l'activation de la Form
Set txtFolio.DataSource = BD
txtFolio.DataField = "folio"
Set txtLot.DataSource = BD
txtLot.DataField = "cad"
txtFolio.Text = ""
txtLot.Text = ""
End Sub
Private Sub cmdESC_Click()
txtLot.Text = ""
txtFolio.Text = ""
txtRecherche.Text = ""
frmKilkenny.Visible = False
frmChertsey.Visible = False
frmWexford.Visible = False
optKilkenny.Value = False
optJulienne.Value = False
optWexford.Value = False
End Sub
Private Sub optAlexis_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Paroisse de Saint-Alexis"
End Sub
Private Sub optChertsey_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Canton de Chertsey"
frmChertsey.Visible = True
frmChertsey.Left = 90
frmChertsey.Top = 1980
frmKilkenny.Visible = False
frmWexford.Visible = False
cmdRetour.Visible = True
cmdRetour.ZOrder 0
End Sub
Private Sub optChertseyRang1_Click()
txtRang.Text = "R01"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang2_Click()
txtRang.Text = "R02"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang3_Click()
txtRang.Text = "R03"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang4_Click()
txtRang.Text = "R04"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang5_Click()
txtRang.Text = "R05"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang6_Click()
txtRang.Text = "R06"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang7_Click()
txtRang.Text = "R07"
txtRecherche.SetFocus
End Sub
Private Sub optEsprit_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Paroisse de Saint-Esprit"
End Sub
Private Sub optJacques_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Paroisse de Saint-Jacques-de-l'Achigan"
End Sub
Private Sub optJulienne_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Paroisse de Sainte-Julienne"
End Sub
Private Sub optKilkenny_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Canton de Kilkenny"
frmKilkenny.Visible = True
frmKilkenny.Left = 90
frmKilkenny.Top = 1980
frmChertsey.Visible = False
frmWexford.Visible = False
cmdRetour.Visible = True
cmdButton.ZOrder 0
End Sub
Private Sub optKilkennyRang10_Click()
txtRang.Text = "R10"
txtRecherche.SetFocus
End Sub
Private Sub optKilkennyRang11_Click()
txtRang.Text = "R11"
txtRecherche.SetFocus
End Sub
Private Sub optKilkennyRang8_Click()
txtRang.Text = "R08"
txtRecherche.SetFocus
End Sub
Private Sub optKilkennyRang9_Click()
txtRang.Text = "R09"
txtRecherche.SetFocus
End Sub
Private Sub optSalome_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Paroisse de Sainte-Marie-Salomé"
End Sub
Private Sub optWexford_Click()
cmdRetour.Visible = True
cmdRetour.ZOrder 0
txtRecherche.SetFocus
txtParoisse.Text = "Canton de Wexford"
frmWexford.Left = 90
frmWexford.Top = 1980
frmWexford.Visible = True
frmKilkenny.Visible = False
frmChertsey.Visible = False
End Sub
Private Sub optWexfordRang1_Click()
txtRang.Text = "R01"
txtRecherche.SetFocus
End Sub
Private Sub optWexfordRang2_Click()
txtRang.Text = "R02"
txtRecherche.SetFocus
End Sub
Private Sub optWexfordRang3_Click()
txtRang.Text = "R03"
txtRecherche.SetFocus
End Sub
Private Sub optWexfordRang4_Click()
txtRang.Text = "R04"
txtRecherche.SetFocus
End Sub
Private Sub optWexfordRang5_Click()
txtRang.Text = "R05"
txtRecherche.SetFocus
End Sub
Private Sub optWexfordRang6_Click()
txtRang.Text = "R06"
txtRecherche.SetFocus
End Sub
Private Sub Timer1_Timer()
lblTimer.Caption = ""
End Sub
sinon on ne le voit pas.....
Mes 3 frames frmKilenny, frm Chertsey et frm Wexford sont tous placé au départ à côté du frame principale (frmParoisse). Donc quand je fais un clique sur, par exemple optChertsey alors le frame se déplace au bon endroit (sur le frmParoisse) et devrait faire apparaite le bouton Retour par dessus ces frames...
Voici le code en entier....
merci d'avance
Option Explicit
Dim Connection As New ADODB.Connection
Dim BD As New ADODB.Recordset
Dim BD2 As New ADODB.Recordset
Dim strRechercheFolio As Integer
Dim OuvertureTIF As Variant
'Variable pour la boulce
'*******************************
Dim strBoucle As Integer '*
Dim Repertoire As String '*
Dim Fichier As String '*
'*******************************
' Cette déclaration est utilisée afin de faire fonctionner le ShellExecute
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'Est utilisé pour fermer le programme
Dim F As Form
For Each F In Forms
Unload F
Next
End Sub
Private Sub Form_Load()
'Type de bases de donnée pour la connexion (Pour Acces 2000 (4.0), pour la version 95 et 97 (3.51)
Connection.Provider = "Microsoft.jet.OLEDB.4.0"
'Chemin de la base de donnée (APP.PATH permet de ce mettre dans le chemin
'courant la ou ce trouve le projet)- Paramettrage de la chaine de connection
Connection.ConnectionString = App.Path & "\FOLIO_RENO.mdb"
'Ouverture de la connection
Connection.Open
'Ouverture de la requête sql dans le recordset
BD.Open "Select * from FOLIO_CADASTRE", Connection, adOpenDynamic, adLockOptimistic
Me.Show
txtRecherche.SetFocus
End Sub
'Est utiliser afin de faire fonctionner la Recherche SQL du Bouton Recherche
'le TXTVersSQL format le text en SQL
Function TXTVersSQL(message As String) As String
message = Replace(message, "'", "''")
TXTVersSQL = "'" & message & "'"
End Function
Private Sub cmdRecherche_Click()
Dim supression As Variant
If optAlexis.Value False And optEsprit.Value False And optJacques.Value = False And optJulienne.Value = False And optSalome.Value = False And optChertsey.Value = False And optKilkenny.Value = False And optWexford.Value = False Then
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Faire une Sélection!"
GoTo Absent
End If
'***************************************************************************************************
'PAROISSE
If optAlexis.Value True Or optEsprit.Value True Or optJacques.Value = True Or optJulienne.Value = True Or optSalome.Value = True Then
Set BD2 = New ADODB.Recordset
BD2.Open "SELECT * FROM [FOLIO_CADASTRE] WHERE [cad] = " & TXTVersSQL(txtRecherche.Text) & " AND [nomcad] = " & TXTVersSQL(txtParoisse.Text), Connection, adOpenKeyset, adLockBatchOptimistic
'BD2.Open "SELECT * FROM [FOLIO_CADASTRE] WHERE [cad] like '" & txtRecherche.Text & "' AND [nomcad] like '" & txtParoisse.Text & "'", Connection, adOpenKeyset, adLockBatchOptimistic
'BD2.Open "SELECT * FROM [GES_TEMPS] WHERE [DOSSIER] like '%" & txtRecherche.Text & "%' AND [EMPLOYER] like '" & ListTempsEmployesRecherche.Text & "'", Connection, adOpenKeyset, adLockBatchOptimistic
'Where cad Like '1' renverra lenregistrement qui contient le caractère 1
'Where cad Like '%1%' renverra tous les enregistrements qui contiennent le caractère 1
'Where cad Like '1%' renverra tous les enregistrements qui commencent par le caractère 1
'Where cad Like '%1' renverra tous les enregistrements qui finissent par le caractère 1
'Code qu'il y avait auparavant
'BD2.Open "SELECT * FROM [FOLIO_CADASTRE] WHERE [cad] like '%" & txtRecherche.Text & "'%", Connection, adOpenKeyset, adLockBatchOptimistic
If BD2.RecordCount <> 0 Then
txtFolio.Text = BD2!folio & ""
txtLot.Text = BD2!cad & ""
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Lot Absent!"
GoTo Absent
End If
If optJulienne.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\STE-JULIENNE"
If txtFolio < 1000 Then
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1680_0" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
Else
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1680_" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
End If
If optAlexis.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\ST-ALEXIS"
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1640_0" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
End If
If optEsprit.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\SAINT-ESPRIT"
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1660_0" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
If optJacques.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\ST-JACQUES"
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1610_0" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
If optSalome.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\STE-MARIE-SALOME"
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1600_0" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
'****************************************************************************************************»
If optChertsey.Value True Or optKilkenny.Value True Or optWexford.Value = True Then
'****************************************************************************************************»
'CANTON
Set BD2 = New ADODB.Recordset
BD2.Open "SELECT * FROM [FOLIO_CADASTRE] WHERE [cad] like '" & txtRecherche.Text & "%' AND [dessec] like '%" & txtRang.Text & "%'", Connection, adOpenKeyset, adLockBatchOptimistic
'BD2.Open "SELECT * FROM [GES_TEMPS] WHERE [DOSSIER] like '%" & txtRecherche.Text & "%' AND [EMPLOYER] like '%" & ListTempsEmployesRecherche.Text & "%'", Connection, adOpenKeyset, adLockBatchOptimistic
'Where cad Like '1' renverra lenregistrement qui contient le caractère 1
'Where cad Like '%1%' renverra tous les enregistrements qui contiennent le caractère 1
'Where cad Like '1%' renverra tous les enregistrements qui commencent par le caractère 1
'Where cad Like '%1' renverra tous les enregistrements qui finissent par le caractère 1
'Code qu'il y avait auparavant
'BD2.Open "SELECT * FROM [FOLIO_CADASTRE] WHERE [cad] like '%" & txtRecherche.Text & "'%", Connection, adOpenKeyset, adLockBatchOptimistic
If BD2.RecordCount <> 0 Then
txtFolio.Text = BD2!folio & ""
txtLot.Text = BD2!cad & ""
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Lot Absent!"
GoTo Absent
End If
If optKilkenny.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\Kilkenny"
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
If optChertsey.Value = True Then
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Plan non numérisé!"
End If
End If
txtRecherche.SetFocus
Absent:
txtRecherche.SetFocus
End Sub
Private Sub form_Activate()
'Chargement des textbox a l'activation de la Form
Set txtFolio.DataSource = BD
txtFolio.DataField = "folio"
Set txtLot.DataSource = BD
txtLot.DataField = "cad"
txtFolio.Text = ""
txtLot.Text = ""
End Sub
Private Sub cmdESC_Click()
txtLot.Text = ""
txtFolio.Text = ""
txtRecherche.Text = ""
frmKilkenny.Visible = False
frmChertsey.Visible = False
frmWexford.Visible = False
optKilkenny.Value = False
optJulienne.Value = False
optWexford.Value = False
End Sub
Private Sub optAlexis_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Paroisse de Saint-Alexis"
End Sub
Private Sub optChertsey_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Canton de Chertsey"
frmChertsey.Visible = True
frmChertsey.Left = 90
frmChertsey.Top = 1980
frmKilkenny.Visible = False
frmWexford.Visible = False
cmdRetour.Visible = True
cmdRetour.ZOrder 0
End Sub
Private Sub optChertseyRang1_Click()
txtRang.Text = "R01"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang2_Click()
txtRang.Text = "R02"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang3_Click()
txtRang.Text = "R03"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang4_Click()
txtRang.Text = "R04"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang5_Click()
txtRang.Text = "R05"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang6_Click()
txtRang.Text = "R06"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang7_Click()
txtRang.Text = "R07"
txtRecherche.SetFocus
End Sub
Private Sub optEsprit_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Paroisse de Saint-Esprit"
End Sub
Private Sub optJacques_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Paroisse de Saint-Jacques-de-l'Achigan"
End Sub
Private Sub optJulienne_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Paroisse de Sainte-Julienne"
End Sub
Private Sub optKilkenny_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Canton de Kilkenny"
frmKilkenny.Visible = True
frmKilkenny.Left = 90
frmKilkenny.Top = 1980
frmChertsey.Visible = False
frmWexford.Visible = False
cmdRetour.Visible = True
cmdButton.ZOrder 0
End Sub
Private Sub optKilkennyRang10_Click()
txtRang.Text = "R10"
txtRecherche.SetFocus
End Sub
Private Sub optKilkennyRang11_Click()
txtRang.Text = "R11"
txtRecherche.SetFocus
End Sub
Private Sub optKilkennyRang8_Click()
txtRang.Text = "R08"
txtRecherche.SetFocus
End Sub
Private Sub optKilkennyRang9_Click()
txtRang.Text = "R09"
txtRecherche.SetFocus
End Sub
Private Sub optSalome_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Paroisse de Sainte-Marie-Salomé"
End Sub
Private Sub optWexford_Click()
cmdRetour.Visible = True
cmdRetour.ZOrder 0
txtRecherche.SetFocus
txtParoisse.Text = "Canton de Wexford"
frmWexford.Left = 90
frmWexford.Top = 1980
frmWexford.Visible = True
frmKilkenny.Visible = False
frmChertsey.Visible = False
End Sub
Private Sub optWexfordRang1_Click()
txtRang.Text = "R01"
txtRecherche.SetFocus
End Sub
Private Sub optWexfordRang2_Click()
txtRang.Text = "R02"
txtRecherche.SetFocus
End Sub
Private Sub optWexfordRang3_Click()
txtRang.Text = "R03"
txtRecherche.SetFocus
End Sub
Private Sub optWexfordRang4_Click()
txtRang.Text = "R04"
txtRecherche.SetFocus
End Sub
Private Sub optWexfordRang5_Click()
txtRang.Text = "R05"
txtRecherche.SetFocus
End Sub
Private Sub optWexfordRang6_Click()
txtRang.Text = "R06"
txtRecherche.SetFocus
End Sub
Private Sub Timer1_Timer()
lblTimer.Caption = ""
End Sub
violent_ken
Messages postés
1812
Date d'inscription
mardi 31 mai 2005
Statut
Membre
Dernière intervention
26 octobre 2010
2
26 août 2005 à 14:41
26 août 2005 à 14:41
J'y voit un peu plus clair, mais pourrais-tu ouvrir ta form avec le bloc-notes, et envoyer le code qu'il y a dedans ?
(le code commence par un truc du genre
VERSION 5.00
Begin VB.Form Win
BackColor = &H00FFC0C0&
BorderStyle = 3 'Fixed Dialog
Caption = ""
ClientHeight = 2235
)
cela me permettra d'avoir tous les composants placés au bon endroit.
Donne moi aussi les références que tu as inclues dans ton projet
@+
(le code commence par un truc du genre
VERSION 5.00
Begin VB.Form Win
BackColor = &H00FFC0C0&
BorderStyle = 3 'Fixed Dialog
Caption = ""
ClientHeight = 2235
)
cela me permettra d'avoir tous les composants placés au bon endroit.
Donne moi aussi les références que tu as inclues dans ton projet
@+
cs_JeffC1977
Messages postés
928
Date d'inscription
vendredi 10 novembre 2000
Statut
Membre
Dernière intervention
23 septembre 2023
4
26 août 2005 à 15:04
26 août 2005 à 15:04
Désolé je n'avais pas vu ca comme ca... alors tel que demandé....
VERSION 5.00
Begin VB.Form PlanCadastre
BackColor = &H00E0E0E0&
BorderStyle = 1 'Fixed Single
Caption = "Plans Cadastraux"
ClientHeight = 7920
ClientLeft = 4725
ClientTop = 3555
ClientWidth = 9750
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "PlanCadastre.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7920
ScaleWidth = 9750
Visible = 0 'False
Begin VB.TextBox txtParoisse
Height = 360
Left = 6600
TabIndex = 53
Top = 450
Visible = 0 'False
Width = 2940
End
Begin VB.Frame frmWexford
BackColor = &H00E0E0E0&
Caption = "Wexford"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1950
Left = 4260
TabIndex = 46
Top = 4875
Visible = 0 'False
Width = 3795
Begin VB.OptionButton optWexfordRang6
BackColor = &H00E0E0E0&
Caption = "Rang 6"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 1320
TabIndex = 52
Top = 300
Width = 1455
End
Begin VB.OptionButton optWexfordRang5
BackColor = &H00E0E0E0&
Caption = "Rang 5"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 51
Top = 1500
Width = 1335
End
Begin VB.OptionButton optWexfordRang4
BackColor = &H00E0E0E0&
Caption = "Rang 4"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 50
Top = 1200
Width = 1155
End
Begin VB.OptionButton optWexfordRang3
BackColor = &H00E0E0E0&
Caption = "Rang 3"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 49
Top = 900
Width = 1215
End
Begin VB.OptionButton optWexfordRang2
BackColor = &H00E0E0E0&
Caption = "Rang 2"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 48
Top = 600
Width = 1335
End
Begin VB.OptionButton optWexfordRang1
BackColor = &H00E0E0E0&
Caption = "Rang 1"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 47
Top = 300
Width = 1395
End
End
Begin VB.Frame frmChertsey
BackColor = &H00E0E0E0&
Caption = "Chertsey"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1950
Left = 4260
TabIndex = 38
Top = 2880
Visible = 0 'False
Width = 3795
Begin VB.OptionButton optChertseyRang7
BackColor = &H00E0E0E0&
Caption = "Rang 7"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 1260
TabIndex = 45
Top = 600
Width = 1275
End
Begin VB.OptionButton optChertseyRang6
BackColor = &H00E0E0E0&
Caption = "Rang 6"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 1260
TabIndex = 44
Top = 300
Width = 1335
End
Begin VB.OptionButton optChertseyRang5
BackColor = &H00E0E0E0&
Caption = "Rang 5"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 43
Top = 1500
Width = 1155
End
Begin VB.OptionButton optChertseyRang4
BackColor = &H00E0E0E0&
Caption = "Rang 4"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 42
Top = 1200
Width = 1335
End
Begin VB.OptionButton optChertseyRang3
BackColor = &H00E0E0E0&
Caption = "Rang 3"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 41
Top = 900
Width = 1095
End
Begin VB.OptionButton optChertseyRang2
BackColor = &H00E0E0E0&
Caption = "Rang 2"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 40
Top = 600
Width = 1335
End
Begin VB.OptionButton optChertseyRang1
BackColor = &H00E0E0E0&
Caption = "Rang 1"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 39
Top = 300
Width = 1395
End
End
Begin VB.TextBox txtRang
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 5430
TabIndex = 36
Top = 405
Visible = 0 'False
Width = 1005
End
Begin VB.Frame frmKilkenny
BackColor = &H00E0E0E0&
Caption = "St-Calixte"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1950
Left = 4275
TabIndex = 22
Top = 840
Visible = 0 'False
Width = 3795
Begin VB.OptionButton optKilkennyBloc1
BackColor = &H00E0E0E0&
Caption = "Bloc 1"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 2565
TabIndex = 35
Top = 900
Width = 870
End
Begin VB.OptionButton optKilkennyGore
BackColor = &H00E0E0E0&
Caption = "Gore"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 2565
TabIndex = 34
Top = 630
Width = 960
End
Begin VB.OptionButton optKilkennyRang10
BackColor = &H00E0E0E0&
Caption = "Rang 10"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 1350
TabIndex = 33
Top = 1395
Width = 960
End
Begin VB.OptionButton optKilkennyRang11
BackColor = &H00E0E0E0&
Caption = "Rang11"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 2565
TabIndex = 32
Top = 360
Width = 915
End
Begin VB.OptionButton optKilkennyRang9
BackColor = &H00E0E0E0&
Caption = "Rang 9"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 1350
TabIndex = 31
Top = 1125
Width = 915
End
Begin VB.OptionButton optKilkennyRang8
BackColor = &H00E0E0E0&
Caption = "Rang 8"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 1350
TabIndex = 30
Top = 855
Width = 1230
End
Begin VB.OptionButton optKilkennyRang7
BackColor = &H00E0E0E0&
Caption = "Rang 7"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 1350
TabIndex = 29
Top = 585
Width = 1050
End
Begin VB.OptionButton optKilkennyRang6
BackColor = &H00E0E0E0&
Caption = "Rang 6"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 1350
TabIndex = 28
Top = 360
Width = 1230
End
Begin VB.OptionButton optKilkennyRang5
BackColor = &H00E0E0E0&
Caption = "Rang 5"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 27
Top = 1395
Width = 960
End
Begin VB.OptionButton optKilkennyRang4
BackColor = &H00E0E0E0&
Caption = "Rang 4"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 26
Top = 1125
Width = 960
End
Begin VB.OptionButton optKilkennyRang3
BackColor = &H00E0E0E0&
Caption = "Rang 3"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 25
Top = 855
Width = 915
End
Begin VB.OptionButton optKilkennyRang2
BackColor = &H00E0E0E0&
Caption = "Rang2"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 24
Top = 585
Width = 870
End
Begin VB.OptionButton optKilkennyRang1
BackColor = &H00E0E0E0&
Caption = "Rang 1"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 23
Top = 315
Width = 870
End
End
Begin VB.Frame frmtimer
BackColor = &H00E0E0E0&
Height = 465
Left = 0
TabIndex = 11
Top = 45
Width = 4020
Begin VB.Label lblTimer
Alignment = 2 'Center
BackColor = &H00E0E0E0&
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 135
TabIndex = 12
Top = 180
Width = 3705
End
End
Begin VB.Frame frmRecherche
BackColor = &H00E0E0E0&
Caption = "Recherche"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1050
Left = -30
TabIndex = 4
Top = 540
Width = 4020
Begin VB.Timer Timer1
Left = 3330
Top = 495
End
Begin VB.CommandButton cmdRecherche
Default = -1 'True
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 2340
Picture = "PlanCadastre.frx":57E2
Style = 1 'Graphical
TabIndex = 7
Top = 360
Width = 600
End
Begin VB.TextBox txtRecherche
Alignment = 2 'Center
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 135
TabIndex = 5
Top = 540
Width = 1815
End
Begin VB.Label lblLot
BackColor = &H00E0E0E0&
Caption = "Lot"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 135
TabIndex = 6
Top = 315
Width = 510
End
End
Begin VB.Frame frmCadastre
BackColor = &H00E0E0E0&
Caption = "Cadastre"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2895
Left = 15
TabIndex = 2
Top = 1620
Width = 3975
Begin VB.CommandButton cmdESC
BackColor = &H00E0E0E0&
Cancel = -1 'True
Caption = "ESC"
CausesValidation= 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 3240
TabIndex = 10
Top = 2385
Width = 600
End
Begin VB.TextBox txtFolio
Alignment = 2 'Center
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 900
TabIndex = 8
Top = 2385
Width = 1050
End
Begin VB.Frame frmParoisse
BackColor = &H00E0E0E0&
Caption = "Paroisse"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1950
Left = 90
TabIndex = 3
Top = 360
Width = 3795
Begin VB.CommandButton cmdRetour
Caption = "Retour"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 2700
TabIndex = 55
Top = 1425
Visible = 0 'False
Width = 915
End
Begin VB.OptionButton optWexford
BackColor = &H00E0E0E0&
Caption = "Wexford 2783"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 2070
TabIndex = 21
Top = 900
Width = 1410
End
Begin VB.OptionButton optKilkenny
BackColor = &H00E0E0E0&
Caption = "St-Calixte 2782"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 2070
TabIndex = 20
Top = 600
Width = 1500
End
Begin VB.OptionButton optChertsey
BackColor = &H00E0E0E0&
Caption = "Chertsey 2784"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 2070
TabIndex = 19
Top = 270
Width = 1410
End
Begin VB.OptionButton optSalome
BackColor = &H00E0E0E0&
Caption = "Ste-Marie-Salomée 2481"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 135
TabIndex = 18
Top = 1530
Width = 2130
End
Begin VB.OptionButton optJulienne
BackColor = &H00E0E0E0&
Caption = "Ste-Julienne 2483"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 135
TabIndex = 17
Top = 1215
Width = 1905
End
Begin VB.OptionButton optJacques
BackColor = &H00E0E0E0&
Caption = "St-Jacques 2481"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 135
TabIndex = 16
Top = 900
Width = 1770
End
Begin VB.OptionButton optEsprit
BackColor = &H00E0E0E0&
Caption = "St-Esprit 2482"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 135
TabIndex = 15
Top = 585
Width = 1365
End
Begin VB.OptionButton optAlexis
BackColor = &H00E0E0E0&
Caption = "St-Alexis"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 135
TabIndex = 14
Top = 270
Width = 1140
End
Begin VB.Label lblCanton
BackColor = &H00E0E0E0&
Caption = "Canton"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 2205
TabIndex = 13
Top = 0
Width = 690
End
End
Begin VB.Label lblFolio
BackColor = &H00E0E0E0&
Caption = "Folio"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 9
Top = 2430
Width = 690
End
End
Begin VB.TextBox txtLot
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 4395
TabIndex = 0
Top = 405
Visible = 0 'False
Width = 915
End
Begin VB.Label Label3
Caption = "Paroisse"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 6600
TabIndex = 54
Top = 150
Visible = 0 'False
Width = 870
End
Begin VB.Label Label2
Caption = "Rang"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 5475
TabIndex = 37
Top = 150
Visible = 0 'False
Width = 870
End
Begin VB.Label Label1
Caption = "Lot"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 4395
TabIndex = 1
Top = 135
Visible = 0 'False
Width = 870
End
End
Attribute VB_Name = "PlanCadastre"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Connection As New ADODB.Connection
Dim BD As New ADODB.Recordset
Dim BD2 As New ADODB.Recordset
Dim strRechercheFolio As Integer
Dim OuvertureTIF As Variant
'Variable pour la boulce
'*******************************
Dim strBoucle As Integer '*
Dim Repertoire As String '*
Dim Fichier As String '*
'*******************************
' Cette déclaration est utilisée afin de faire fonctionner le ShellExecute
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'Est utilisé pour fermer le programme
Dim F As Form
For Each F In Forms
Unload F
Next
End Sub
Private Sub Form_Load()
'Type de bases de donnée pour la connexion (Pour Acces 2000 (4.0), pour la version 95 et 97 (3.51)
Connection.Provider = "Microsoft.jet.OLEDB.4.0"
'Chemin de la base de donnée (APP.PATH permet de ce mettre dans le chemin
'courant la ou ce trouve le projet)- Paramettrage de la chaine de connection
Connection.ConnectionString = App.Path & "\FOLIO_RENO.mdb"
'Ouverture de la connection
Connection.Open
'Ouverture de la requête sql dans le recordset
BD.Open "Select * from FOLIO_CADASTRE", Connection, adOpenDynamic, adLockOptimistic
Me.Show
txtRecherche.SetFocus
End Sub
'Est utiliser afin de faire fonctionner la Recherche SQL du Bouton Recherche
'le TXTVersSQL format le text en SQL
Function TXTVersSQL(message As String) As String
message = Replace(message, "'", "''")
TXTVersSQL = "'" & message & "'"
End Function
Private Sub cmdRecherche_Click()
Dim supression As Variant
If optAlexis.Value False And optEsprit.Value False And optJacques.Value = False And optJulienne.Value = False And optSalome.Value = False And optChertsey.Value = False And optKilkenny.Value = False And optWexford.Value = False Then
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Faire une Sélection!"
GoTo Absent
End If
'***************************************************************************************************
'PAROISSE
If optAlexis.Value True Or optEsprit.Value True Or optJacques.Value = True Or optJulienne.Value = True Or optSalome.Value = True Then
Set BD2 = New ADODB.Recordset
BD2.Open "SELECT * FROM [FOLIO_CADASTRE] WHERE [cad] = " & TXTVersSQL(txtRecherche.Text) & " AND [nomcad] = " & TXTVersSQL(txtParoisse.Text), Connection, adOpenKeyset, adLockBatchOptimistic
'BD2.Open "SELECT * FROM [FOLIO_CADASTRE] WHERE [cad] like '" & txtRecherche.Text & "' AND [nomcad] like '" & txtParoisse.Text & "'", Connection, adOpenKeyset, adLockBatchOptimistic
'BD2.Open "SELECT * FROM [GES_TEMPS] WHERE [DOSSIER] like '%" & txtRecherche.Text & "%' AND [EMPLOYER] like '" & ListTempsEmployesRecherche.Text & "'", Connection, adOpenKeyset, adLockBatchOptimistic
'Where cad Like '1' renverra lenregistrement qui contient le caractère 1
'Where cad Like '%1%' renverra tous les enregistrements qui contiennent le caractère 1
'Where cad Like '1%' renverra tous les enregistrements qui commencent par le caractère 1
'Where cad Like '%1' renverra tous les enregistrements qui finissent par le caractère 1
'Code qu'il y avait auparavant
'BD2.Open "SELECT * FROM [FOLIO_CADASTRE] WHERE [cad] like '%" & txtRecherche.Text & "'%", Connection, adOpenKeyset, adLockBatchOptimistic
If BD2.RecordCount <> 0 Then
txtFolio.Text = BD2!folio & ""
txtLot.Text = BD2!cad & ""
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Lot Absent!"
GoTo Absent
End If
If optJulienne.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\STE-JULIENNE"
If txtFolio < 1000 Then
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1680_0" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
Else
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1680_" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
End If
If optAlexis.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\ST-ALEXIS"
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1640_0" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
End If
If optEsprit.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\SAINT-ESPRIT"
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1660_0" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
If optJacques.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\ST-JACQUES"
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1610_0" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
If optSalome.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\STE-MARIE-SALOME"
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1600_0" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
'****************************************************************************************************»
If optChertsey.Value True Or optKilkenny.Value True Or optWexford.Value = True Then
'****************************************************************************************************»
'CANTON
Set BD2 = New ADODB.Recordset
BD2.Open "SELECT * FROM [FOLIO_CADASTRE] WHERE [cad] like '" & txtRecherche.Text & "%' AND [dessec] like '%" & txtRang.Text & "%'", Connection, adOpenKeyset, adLockBatchOptimistic
'BD2.Open "SELECT * FROM [GES_TEMPS] WHERE [DOSSIER] like '%" & txtRecherche.Text & "%' AND [EMPLOYER] like '%" & ListTempsEmployesRecherche.Text & "%'", Connection, adOpenKeyset, adLockBatchOptimistic
'Where cad Like '1' renverra lenregistrement qui contient le caractère 1
'Where cad Like '%1%' renverra tous les enregistrements qui contiennent le caractère 1
'Where cad Like '1%' renverra tous les enregistrements qui commencent par le caractère 1
'Where cad Like '%1' renverra tous les enregistrements qui finissent par le caractère 1
'Code qu'il y avait auparavant
'BD2.Open "SELECT * FROM [FOLIO_CADASTRE] WHERE [cad] like '%" & txtRecherche.Text & "'%", Connection, adOpenKeyset, adLockBatchOptimistic
If BD2.RecordCount <> 0 Then
txtFolio.Text = BD2!folio & ""
txtLot.Text = BD2!cad & ""
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Lot Absent!"
GoTo Absent
End If
If optKilkenny.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\Kilkenny"
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
If optChertsey.Value = True Then
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Plan non numérisé!"
End If
End If
txtRecherche.SetFocus
Absent:
txtRecherche.SetFocus
End Sub
Private Sub form_Activate()
'Chargement des textbox a l'activation de la Form
Set txtFolio.DataSource = BD
txtFolio.DataField = "folio"
Set txtLot.DataSource = BD
txtLot.DataField = "cad"
txtFolio.Text = ""
txtLot.Text = ""
End Sub
Private Sub cmdESC_Click()
txtLot.Text = ""
txtFolio.Text = ""
txtRecherche.Text = ""
frmKilkenny.Visible = False
frmChertsey.Visible = False
frmWexford.Visible = False
optKilkenny.Value = False
optJulienne.Value = False
optWexford.Value = False
End Sub
Private Sub optAlexis_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Paroisse de Saint-Alexis"
End Sub
Private Sub optChertsey_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Canton de Chertsey"
frmChertsey.Visible = True
frmChertsey.Left = 90
frmChertsey.Top = 1980
frmKilkenny.Visible = False
frmWexford.Visible = False
cmdRetour.Visible = True
cmdRetour.ZOrder 0
End Sub
Private Sub optChertseyRang1_Click()
txtRang.Text = "R01"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang2_Click()
txtRang.Text = "R02"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang3_Click()
txtRang.Text = "R03"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang4_Click()
txtRang.Text = "R04"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang5_Click()
txtRang.Text = "R05"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang6_Click()
txtRang.Text = "R06"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang7_Click()
txtRang.Text = "R07"
txtRecherche.SetFocus
End Sub
Private Sub optEsprit_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Paroisse de Saint-Esprit"
End Sub
Private Sub optJacques_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Paroisse de Saint-Jacques-de-l'Achigan"
End Sub
Private Sub optJulienne_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Paroisse de Sainte-Julienne"
End Sub
Private Sub optKilkenny_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Canton de Kilkenny"
frmKilkenny.Visible = True
frmKilkenny.Left = 90
frmKilkenny.Top = 1980
frmChertsey.Visible = False
frmWexford.Visible = False
cmdRetour.Visible = True
cmdButton.ZOrder 0
End Sub
Private Sub optKilkennyRang10_Click()
txtRang.Text = "R10"
txtRecherche.SetFocus
End Sub
Private Sub optKilkennyRang11_Click()
txtRang.Text = "R11"
txtRecherche.SetFocus
End Sub
Private Sub optKilkennyRang8_Click()
txtRang.Text = "R08"
txtRecherche.SetFocus
End Sub
Private Sub optKilkennyRang9_Click()
txtRang.Text = "R09"
txtRecherche.SetFocus
End Sub
Private Sub optSalome_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Paroisse de Sainte-Marie-Salomé"
End Sub
Private Sub optWexford_Click()
cmdRetour.Visible = True
cmdRetour.ZOrder 0
txtRecherche.SetFocus
txtParoisse.Text = "Canton de Wexford"
frmWexford.Left = 90
frmWexford.Top = 1980
frmWexford.Visible = True
frmKilkenny.Visible = False
frmChertsey.Visible = False
End Sub
Private Sub optWexfordRang1_Click()
txtRang.Text = "R01"
txtRecherche.SetFocus
End Sub
Private Sub optWexfordRang2_Click()
txtRang.Text = "R02"
txtRecherche.SetFocus
End Sub
Private Sub optWexfordRang3_Click()
txtRang.Text = "R03"
txtRecherche.SetFocus
End Sub
Private Sub optWexfordRang4_Click()
txtRang.Text = "R04"
txtRecherche.SetFocus
End Sub
Private Sub optWexfordRang5_Click()
txtRang.Text = "R05"
txtRecherche.SetFocus
End Sub
Private Sub optWexfordRang6_Click()
txtRang.Text = "R06"
txtRecherche.SetFocus
End Sub
Private Sub Timer1_Timer()
lblTimer.Caption = ""
End Sub
RÉFÉRENCES
VB For Applications
VB runtime objects and procedures
VB objects ans procedures
OLE Automation
Microsoft ActiveX Data Objetcs 2.7 Library
Microsoft Data Binding Collection...
Voilà...
Merci encore...
VERSION 5.00
Begin VB.Form PlanCadastre
BackColor = &H00E0E0E0&
BorderStyle = 1 'Fixed Single
Caption = "Plans Cadastraux"
ClientHeight = 7920
ClientLeft = 4725
ClientTop = 3555
ClientWidth = 9750
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "PlanCadastre.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7920
ScaleWidth = 9750
Visible = 0 'False
Begin VB.TextBox txtParoisse
Height = 360
Left = 6600
TabIndex = 53
Top = 450
Visible = 0 'False
Width = 2940
End
Begin VB.Frame frmWexford
BackColor = &H00E0E0E0&
Caption = "Wexford"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1950
Left = 4260
TabIndex = 46
Top = 4875
Visible = 0 'False
Width = 3795
Begin VB.OptionButton optWexfordRang6
BackColor = &H00E0E0E0&
Caption = "Rang 6"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 1320
TabIndex = 52
Top = 300
Width = 1455
End
Begin VB.OptionButton optWexfordRang5
BackColor = &H00E0E0E0&
Caption = "Rang 5"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 51
Top = 1500
Width = 1335
End
Begin VB.OptionButton optWexfordRang4
BackColor = &H00E0E0E0&
Caption = "Rang 4"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 50
Top = 1200
Width = 1155
End
Begin VB.OptionButton optWexfordRang3
BackColor = &H00E0E0E0&
Caption = "Rang 3"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 49
Top = 900
Width = 1215
End
Begin VB.OptionButton optWexfordRang2
BackColor = &H00E0E0E0&
Caption = "Rang 2"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 48
Top = 600
Width = 1335
End
Begin VB.OptionButton optWexfordRang1
BackColor = &H00E0E0E0&
Caption = "Rang 1"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 47
Top = 300
Width = 1395
End
End
Begin VB.Frame frmChertsey
BackColor = &H00E0E0E0&
Caption = "Chertsey"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1950
Left = 4260
TabIndex = 38
Top = 2880
Visible = 0 'False
Width = 3795
Begin VB.OptionButton optChertseyRang7
BackColor = &H00E0E0E0&
Caption = "Rang 7"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 1260
TabIndex = 45
Top = 600
Width = 1275
End
Begin VB.OptionButton optChertseyRang6
BackColor = &H00E0E0E0&
Caption = "Rang 6"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 1260
TabIndex = 44
Top = 300
Width = 1335
End
Begin VB.OptionButton optChertseyRang5
BackColor = &H00E0E0E0&
Caption = "Rang 5"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 43
Top = 1500
Width = 1155
End
Begin VB.OptionButton optChertseyRang4
BackColor = &H00E0E0E0&
Caption = "Rang 4"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 42
Top = 1200
Width = 1335
End
Begin VB.OptionButton optChertseyRang3
BackColor = &H00E0E0E0&
Caption = "Rang 3"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 41
Top = 900
Width = 1095
End
Begin VB.OptionButton optChertseyRang2
BackColor = &H00E0E0E0&
Caption = "Rang 2"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 40
Top = 600
Width = 1335
End
Begin VB.OptionButton optChertseyRang1
BackColor = &H00E0E0E0&
Caption = "Rang 1"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 39
Top = 300
Width = 1395
End
End
Begin VB.TextBox txtRang
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 5430
TabIndex = 36
Top = 405
Visible = 0 'False
Width = 1005
End
Begin VB.Frame frmKilkenny
BackColor = &H00E0E0E0&
Caption = "St-Calixte"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1950
Left = 4275
TabIndex = 22
Top = 840
Visible = 0 'False
Width = 3795
Begin VB.OptionButton optKilkennyBloc1
BackColor = &H00E0E0E0&
Caption = "Bloc 1"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 2565
TabIndex = 35
Top = 900
Width = 870
End
Begin VB.OptionButton optKilkennyGore
BackColor = &H00E0E0E0&
Caption = "Gore"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 2565
TabIndex = 34
Top = 630
Width = 960
End
Begin VB.OptionButton optKilkennyRang10
BackColor = &H00E0E0E0&
Caption = "Rang 10"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 1350
TabIndex = 33
Top = 1395
Width = 960
End
Begin VB.OptionButton optKilkennyRang11
BackColor = &H00E0E0E0&
Caption = "Rang11"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 2565
TabIndex = 32
Top = 360
Width = 915
End
Begin VB.OptionButton optKilkennyRang9
BackColor = &H00E0E0E0&
Caption = "Rang 9"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 1350
TabIndex = 31
Top = 1125
Width = 915
End
Begin VB.OptionButton optKilkennyRang8
BackColor = &H00E0E0E0&
Caption = "Rang 8"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 1350
TabIndex = 30
Top = 855
Width = 1230
End
Begin VB.OptionButton optKilkennyRang7
BackColor = &H00E0E0E0&
Caption = "Rang 7"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 1350
TabIndex = 29
Top = 585
Width = 1050
End
Begin VB.OptionButton optKilkennyRang6
BackColor = &H00E0E0E0&
Caption = "Rang 6"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 1350
TabIndex = 28
Top = 360
Width = 1230
End
Begin VB.OptionButton optKilkennyRang5
BackColor = &H00E0E0E0&
Caption = "Rang 5"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 27
Top = 1395
Width = 960
End
Begin VB.OptionButton optKilkennyRang4
BackColor = &H00E0E0E0&
Caption = "Rang 4"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 26
Top = 1125
Width = 960
End
Begin VB.OptionButton optKilkennyRang3
BackColor = &H00E0E0E0&
Caption = "Rang 3"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 25
Top = 855
Width = 915
End
Begin VB.OptionButton optKilkennyRang2
BackColor = &H00E0E0E0&
Caption = "Rang2"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 24
Top = 585
Width = 870
End
Begin VB.OptionButton optKilkennyRang1
BackColor = &H00E0E0E0&
Caption = "Rang 1"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 23
Top = 315
Width = 870
End
End
Begin VB.Frame frmtimer
BackColor = &H00E0E0E0&
Height = 465
Left = 0
TabIndex = 11
Top = 45
Width = 4020
Begin VB.Label lblTimer
Alignment = 2 'Center
BackColor = &H00E0E0E0&
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 135
TabIndex = 12
Top = 180
Width = 3705
End
End
Begin VB.Frame frmRecherche
BackColor = &H00E0E0E0&
Caption = "Recherche"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1050
Left = -30
TabIndex = 4
Top = 540
Width = 4020
Begin VB.Timer Timer1
Left = 3330
Top = 495
End
Begin VB.CommandButton cmdRecherche
Default = -1 'True
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 2340
Picture = "PlanCadastre.frx":57E2
Style = 1 'Graphical
TabIndex = 7
Top = 360
Width = 600
End
Begin VB.TextBox txtRecherche
Alignment = 2 'Center
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 135
TabIndex = 5
Top = 540
Width = 1815
End
Begin VB.Label lblLot
BackColor = &H00E0E0E0&
Caption = "Lot"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 135
TabIndex = 6
Top = 315
Width = 510
End
End
Begin VB.Frame frmCadastre
BackColor = &H00E0E0E0&
Caption = "Cadastre"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2895
Left = 15
TabIndex = 2
Top = 1620
Width = 3975
Begin VB.CommandButton cmdESC
BackColor = &H00E0E0E0&
Cancel = -1 'True
Caption = "ESC"
CausesValidation= 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 3240
TabIndex = 10
Top = 2385
Width = 600
End
Begin VB.TextBox txtFolio
Alignment = 2 'Center
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 900
TabIndex = 8
Top = 2385
Width = 1050
End
Begin VB.Frame frmParoisse
BackColor = &H00E0E0E0&
Caption = "Paroisse"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1950
Left = 90
TabIndex = 3
Top = 360
Width = 3795
Begin VB.CommandButton cmdRetour
Caption = "Retour"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 2700
TabIndex = 55
Top = 1425
Visible = 0 'False
Width = 915
End
Begin VB.OptionButton optWexford
BackColor = &H00E0E0E0&
Caption = "Wexford 2783"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 2070
TabIndex = 21
Top = 900
Width = 1410
End
Begin VB.OptionButton optKilkenny
BackColor = &H00E0E0E0&
Caption = "St-Calixte 2782"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 2070
TabIndex = 20
Top = 600
Width = 1500
End
Begin VB.OptionButton optChertsey
BackColor = &H00E0E0E0&
Caption = "Chertsey 2784"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 2070
TabIndex = 19
Top = 270
Width = 1410
End
Begin VB.OptionButton optSalome
BackColor = &H00E0E0E0&
Caption = "Ste-Marie-Salomée 2481"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 135
TabIndex = 18
Top = 1530
Width = 2130
End
Begin VB.OptionButton optJulienne
BackColor = &H00E0E0E0&
Caption = "Ste-Julienne 2483"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 135
TabIndex = 17
Top = 1215
Width = 1905
End
Begin VB.OptionButton optJacques
BackColor = &H00E0E0E0&
Caption = "St-Jacques 2481"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 135
TabIndex = 16
Top = 900
Width = 1770
End
Begin VB.OptionButton optEsprit
BackColor = &H00E0E0E0&
Caption = "St-Esprit 2482"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 135
TabIndex = 15
Top = 585
Width = 1365
End
Begin VB.OptionButton optAlexis
BackColor = &H00E0E0E0&
Caption = "St-Alexis"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 135
TabIndex = 14
Top = 270
Width = 1140
End
Begin VB.Label lblCanton
BackColor = &H00E0E0E0&
Caption = "Canton"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 2205
TabIndex = 13
Top = 0
Width = 690
End
End
Begin VB.Label lblFolio
BackColor = &H00E0E0E0&
Caption = "Folio"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 9
Top = 2430
Width = 690
End
End
Begin VB.TextBox txtLot
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 4395
TabIndex = 0
Top = 405
Visible = 0 'False
Width = 915
End
Begin VB.Label Label3
Caption = "Paroisse"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 6600
TabIndex = 54
Top = 150
Visible = 0 'False
Width = 870
End
Begin VB.Label Label2
Caption = "Rang"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 5475
TabIndex = 37
Top = 150
Visible = 0 'False
Width = 870
End
Begin VB.Label Label1
Caption = "Lot"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 4395
TabIndex = 1
Top = 135
Visible = 0 'False
Width = 870
End
End
Attribute VB_Name = "PlanCadastre"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Connection As New ADODB.Connection
Dim BD As New ADODB.Recordset
Dim BD2 As New ADODB.Recordset
Dim strRechercheFolio As Integer
Dim OuvertureTIF As Variant
'Variable pour la boulce
'*******************************
Dim strBoucle As Integer '*
Dim Repertoire As String '*
Dim Fichier As String '*
'*******************************
' Cette déclaration est utilisée afin de faire fonctionner le ShellExecute
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'Est utilisé pour fermer le programme
Dim F As Form
For Each F In Forms
Unload F
Next
End Sub
Private Sub Form_Load()
'Type de bases de donnée pour la connexion (Pour Acces 2000 (4.0), pour la version 95 et 97 (3.51)
Connection.Provider = "Microsoft.jet.OLEDB.4.0"
'Chemin de la base de donnée (APP.PATH permet de ce mettre dans le chemin
'courant la ou ce trouve le projet)- Paramettrage de la chaine de connection
Connection.ConnectionString = App.Path & "\FOLIO_RENO.mdb"
'Ouverture de la connection
Connection.Open
'Ouverture de la requête sql dans le recordset
BD.Open "Select * from FOLIO_CADASTRE", Connection, adOpenDynamic, adLockOptimistic
Me.Show
txtRecherche.SetFocus
End Sub
'Est utiliser afin de faire fonctionner la Recherche SQL du Bouton Recherche
'le TXTVersSQL format le text en SQL
Function TXTVersSQL(message As String) As String
message = Replace(message, "'", "''")
TXTVersSQL = "'" & message & "'"
End Function
Private Sub cmdRecherche_Click()
Dim supression As Variant
If optAlexis.Value False And optEsprit.Value False And optJacques.Value = False And optJulienne.Value = False And optSalome.Value = False And optChertsey.Value = False And optKilkenny.Value = False And optWexford.Value = False Then
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Faire une Sélection!"
GoTo Absent
End If
'***************************************************************************************************
'PAROISSE
If optAlexis.Value True Or optEsprit.Value True Or optJacques.Value = True Or optJulienne.Value = True Or optSalome.Value = True Then
Set BD2 = New ADODB.Recordset
BD2.Open "SELECT * FROM [FOLIO_CADASTRE] WHERE [cad] = " & TXTVersSQL(txtRecherche.Text) & " AND [nomcad] = " & TXTVersSQL(txtParoisse.Text), Connection, adOpenKeyset, adLockBatchOptimistic
'BD2.Open "SELECT * FROM [FOLIO_CADASTRE] WHERE [cad] like '" & txtRecherche.Text & "' AND [nomcad] like '" & txtParoisse.Text & "'", Connection, adOpenKeyset, adLockBatchOptimistic
'BD2.Open "SELECT * FROM [GES_TEMPS] WHERE [DOSSIER] like '%" & txtRecherche.Text & "%' AND [EMPLOYER] like '" & ListTempsEmployesRecherche.Text & "'", Connection, adOpenKeyset, adLockBatchOptimistic
'Where cad Like '1' renverra lenregistrement qui contient le caractère 1
'Where cad Like '%1%' renverra tous les enregistrements qui contiennent le caractère 1
'Where cad Like '1%' renverra tous les enregistrements qui commencent par le caractère 1
'Where cad Like '%1' renverra tous les enregistrements qui finissent par le caractère 1
'Code qu'il y avait auparavant
'BD2.Open "SELECT * FROM [FOLIO_CADASTRE] WHERE [cad] like '%" & txtRecherche.Text & "'%", Connection, adOpenKeyset, adLockBatchOptimistic
If BD2.RecordCount <> 0 Then
txtFolio.Text = BD2!folio & ""
txtLot.Text = BD2!cad & ""
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Lot Absent!"
GoTo Absent
End If
If optJulienne.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\STE-JULIENNE"
If txtFolio < 1000 Then
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1680_0" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
Else
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1680_" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
End If
If optAlexis.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\ST-ALEXIS"
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1640_0" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
End If
If optEsprit.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\SAINT-ESPRIT"
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1660_0" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
If optJacques.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\ST-JACQUES"
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1610_0" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
If optSalome.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\STE-MARIE-SALOME"
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & "1600_0" & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
'****************************************************************************************************»
If optChertsey.Value True Or optKilkenny.Value True Or optWexford.Value = True Then
'****************************************************************************************************»
'CANTON
Set BD2 = New ADODB.Recordset
BD2.Open "SELECT * FROM [FOLIO_CADASTRE] WHERE [cad] like '" & txtRecherche.Text & "%' AND [dessec] like '%" & txtRang.Text & "%'", Connection, adOpenKeyset, adLockBatchOptimistic
'BD2.Open "SELECT * FROM [GES_TEMPS] WHERE [DOSSIER] like '%" & txtRecherche.Text & "%' AND [EMPLOYER] like '%" & ListTempsEmployesRecherche.Text & "%'", Connection, adOpenKeyset, adLockBatchOptimistic
'Where cad Like '1' renverra lenregistrement qui contient le caractère 1
'Where cad Like '%1%' renverra tous les enregistrements qui contiennent le caractère 1
'Where cad Like '1%' renverra tous les enregistrements qui commencent par le caractère 1
'Where cad Like '%1' renverra tous les enregistrements qui finissent par le caractère 1
'Code qu'il y avait auparavant
'BD2.Open "SELECT * FROM [FOLIO_CADASTRE] WHERE [cad] like '%" & txtRecherche.Text & "'%", Connection, adOpenKeyset, adLockBatchOptimistic
If BD2.RecordCount <> 0 Then
txtFolio.Text = BD2!folio & ""
txtLot.Text = BD2!cad & ""
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Lot Absent!"
GoTo Absent
End If
If optKilkenny.Value = True Then
Repertoire = "M:\Recherches_BPD\PLAN\Kilkenny"
For strRechercheFolio = txtFolio.Text To 1 Step -1 'Dans une Boucle, la variable doit être INTEGER
txtFolio.Text = strRechercheFolio
Fichier = Repertoire & strRechercheFolio & ".tif"
If Dir(Fichier) <> "" Then Exit For
Next
If strRechercheFolio > 0 Then
OuvertureTIF = ShellExecute(Me.hWnd, "open", Fichier, vbNullString, "", SW_SHOWNORMAL)
Else
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Problème à l'exécution!"
End If
End If
If optChertsey.Value = True Then
Timer1.Enabled = True
Timer1.Interval = 2000
lblTimer.Caption = "Plan non numérisé!"
End If
End If
txtRecherche.SetFocus
Absent:
txtRecherche.SetFocus
End Sub
Private Sub form_Activate()
'Chargement des textbox a l'activation de la Form
Set txtFolio.DataSource = BD
txtFolio.DataField = "folio"
Set txtLot.DataSource = BD
txtLot.DataField = "cad"
txtFolio.Text = ""
txtLot.Text = ""
End Sub
Private Sub cmdESC_Click()
txtLot.Text = ""
txtFolio.Text = ""
txtRecherche.Text = ""
frmKilkenny.Visible = False
frmChertsey.Visible = False
frmWexford.Visible = False
optKilkenny.Value = False
optJulienne.Value = False
optWexford.Value = False
End Sub
Private Sub optAlexis_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Paroisse de Saint-Alexis"
End Sub
Private Sub optChertsey_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Canton de Chertsey"
frmChertsey.Visible = True
frmChertsey.Left = 90
frmChertsey.Top = 1980
frmKilkenny.Visible = False
frmWexford.Visible = False
cmdRetour.Visible = True
cmdRetour.ZOrder 0
End Sub
Private Sub optChertseyRang1_Click()
txtRang.Text = "R01"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang2_Click()
txtRang.Text = "R02"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang3_Click()
txtRang.Text = "R03"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang4_Click()
txtRang.Text = "R04"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang5_Click()
txtRang.Text = "R05"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang6_Click()
txtRang.Text = "R06"
txtRecherche.SetFocus
End Sub
Private Sub optChertseyRang7_Click()
txtRang.Text = "R07"
txtRecherche.SetFocus
End Sub
Private Sub optEsprit_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Paroisse de Saint-Esprit"
End Sub
Private Sub optJacques_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Paroisse de Saint-Jacques-de-l'Achigan"
End Sub
Private Sub optJulienne_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Paroisse de Sainte-Julienne"
End Sub
Private Sub optKilkenny_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Canton de Kilkenny"
frmKilkenny.Visible = True
frmKilkenny.Left = 90
frmKilkenny.Top = 1980
frmChertsey.Visible = False
frmWexford.Visible = False
cmdRetour.Visible = True
cmdButton.ZOrder 0
End Sub
Private Sub optKilkennyRang10_Click()
txtRang.Text = "R10"
txtRecherche.SetFocus
End Sub
Private Sub optKilkennyRang11_Click()
txtRang.Text = "R11"
txtRecherche.SetFocus
End Sub
Private Sub optKilkennyRang8_Click()
txtRang.Text = "R08"
txtRecherche.SetFocus
End Sub
Private Sub optKilkennyRang9_Click()
txtRang.Text = "R09"
txtRecherche.SetFocus
End Sub
Private Sub optSalome_Click()
txtRecherche.SetFocus
txtParoisse.Text = "Paroisse de Sainte-Marie-Salomé"
End Sub
Private Sub optWexford_Click()
cmdRetour.Visible = True
cmdRetour.ZOrder 0
txtRecherche.SetFocus
txtParoisse.Text = "Canton de Wexford"
frmWexford.Left = 90
frmWexford.Top = 1980
frmWexford.Visible = True
frmKilkenny.Visible = False
frmChertsey.Visible = False
End Sub
Private Sub optWexfordRang1_Click()
txtRang.Text = "R01"
txtRecherche.SetFocus
End Sub
Private Sub optWexfordRang2_Click()
txtRang.Text = "R02"
txtRecherche.SetFocus
End Sub
Private Sub optWexfordRang3_Click()
txtRang.Text = "R03"
txtRecherche.SetFocus
End Sub
Private Sub optWexfordRang4_Click()
txtRang.Text = "R04"
txtRecherche.SetFocus
End Sub
Private Sub optWexfordRang5_Click()
txtRang.Text = "R05"
txtRecherche.SetFocus
End Sub
Private Sub optWexfordRang6_Click()
txtRang.Text = "R06"
txtRecherche.SetFocus
End Sub
Private Sub Timer1_Timer()
lblTimer.Caption = ""
End Sub
RÉFÉRENCES
VB For Applications
VB runtime objects and procedures
VB objects ans procedures
OLE Automation
Microsoft ActiveX Data Objetcs 2.7 Library
Microsoft Data Binding Collection...
Voilà...
Merci encore...
cs_JeffC1977
Messages postés
928
Date d'inscription
vendredi 10 novembre 2000
Statut
Membre
Dernière intervention
23 septembre 2023
4
26 août 2005 à 16:06
26 août 2005 à 16:06
Une gros merci je check ca dans une couple d'heure et je te refais signe (Je vais venir faire un clic sur RÉPONSE ACCEPTÉE
bye
bye