Sujet Précédent Sujet Suivant

Problèmes divers variable with et select case

CYCY07 Messages postés 67 Date d'inscription jeudi 19 mai 2011 Statut Membre Dernière intervention 22 mai 2006 - 29 août 2005 à 11:11
CYCY07 Messages postés 67 Date d'inscription jeudi 19 mai 2011 Statut Membre Dernière intervention 22 mai 2006 - 29 août 2005 à 11:28
Bonjour, j'ai créé une feuille comprenant une Toolbar, 3textbox, 1 composant DBgrid, 1 composant Data, ListImage, etc

Lorsque j'exécute mon projet il me dit : « erreur 91 variable objet ou variable bloc with non définit »

Voici là où ça coince :

Public Sub UpdateButtons(Optional bLockEm As Variant, Optional ctrlDataEC As Object)
'Détermine quel est l'état du jeu d'enregistrement
'(aucune opération d'édition en cours)
'(édition en cours avec l'enregistrement courrant dans la mémoire tampon)
'(ajout d'un enregistrement avec un enregistrement vide en cours)

If Not (TypeOf Screen.ActiveForm.ActiveControl Is DBGrid) Then
Set ctrlDataEC = DLocalite
lgTotalRecordsEC = lgTotalRecords
End If

Select Case ctrlDataEC.Recordset.EditMode
Case dbEditNone 'pas d'edition en cours, gère simplement la navigation
If (lgTotalRecordsEC >= 2) Then
If (ctrlDataEC.Recordset.BOF) Or (ctrlDataEC.Recordset.AbsolutePosition = 0) Then
'Appelle de la procédure navigateButtons avec passage d'argument
'L'argument est une chaîne de 11 "0 ou 1" représentant l'état des 11 boutons de commandes

If (Me.ActiveControl.Tag <> "2") Then
navigateButtons ("00111101011")
Else
navigateButtons ("00111101001")
End If
ElseIf (ctrlDataEC.Recordset.EOF) Or (ctrlDataEC.Recordset.AbsolutePosition = lgTotalRecordsEC - 1) Then
If (Me.ActiveControl.Tag <> "2") Then
navigateButtons ("11001101011")
Else
navigateButtons ("11001101001")
End If
Else
If (Me.ActiveControl.Tag <> "2") Then
navigateButtons ("11111101011")
Else
navigateButtons ("11111101001")
End If
End If
ElseIf (lgTotalRecordsEC > 0) Then
navigateButtons ("00001101001")
Else
navigateButtons ("00001000001")
End If
If (Not IsMissing(bLockEm)) Then
lockTheControls (bLockEm)
End If
Case dbEditInProgress 'Modification de l'enregistrement courant en cours
Call lockTheControls(False)
If Not (TypeOf Me.ActiveControl Is DBGrid) Then
Text1(1).SetFocus
End If
navigateButtons ("00000010100")
Case dbEditAdd 'Ajout d'un nouvel enregistrement en cours
Call lockTheControls(False)
navigateButtons ("00000010100")
End Select
End Sub

Il y a donc plusieurs problèmes :

* (Me.ActiveControl.Tag <> "2")
le composant Tag a bien été mis dans les propriétés de la DBGrid
il m'indique comme erreur lors de l'exécution : variable objet ou variable bloc with non défini

* Case dbEditInProgress
Qu'il n'y a pas de select

Je ne sais pas quoi faire et ce code m'est essentiel pour le bon fonctionnement de mon projet...
Merci pour votre aide
Cycy
A voir également:

2 réponses

Réponse 1 / 2
violent_ken Messages postés 1812 Date d'inscription mardi 31 mai 2005 Statut Membre Dernière intervention 26 octobre 2010 2
29 août 2005 à 11:21
Violent Ken

Salut
Peux tu ouvrir ta form avec le bloc notes, et envoyer tout le contenu sur ce forum ?
Cela permettra d'avoir la form complète et de pouvoir localiser les problèmes plus facilement.
@+

Note: çà doit commencer par

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form Form_pop_bn
Caption = "Form2"
ClientHeight = 3090
ClientLeft = 165
ClientTop = 84

ou un truc dans le genre...
0
Réponse 2 / 2
CYCY07 Messages postés 67 Date d'inscription jeudi 19 mai 2011 Statut Membre Dernière intervention 22 mai 2006
29 août 2005 à 11:28
VERSION 5.00
Object = "{00028C01-0000-0000-0000-000000000046}#1.0#0"; "DBGRID32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form F_Localit
BackColor = &H00C0E0FF&
Caption = "Gestion des localités"
ClientHeight = 6525
ClientLeft = 165
ClientTop = 855
ClientWidth = 7665
LinkTopic = "Form1"
ScaleHeight = 6525
ScaleWidth = 7665
StartUpPosition = 3 'Windows Default
Begin MSComctlLib.ImageList ImageList1
Left = 6480
Top = 840
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 32
ImageHeight = 32
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 10
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "F_Localit.frx":0000
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "F_Localit.frx":0452
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "F_Localit.frx":08A4
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "F_Localit.frx":0CF6
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "F_Localit.frx":1148
Key = ""
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "F_Localit.frx":159A
Key = ""
EndProperty
BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "F_Localit.frx":19EC
Key = ""
EndProperty
BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "F_Localit.frx":1E3E
Key = ""
EndProperty
BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "F_Localit.frx":1F50
Key = ""
EndProperty
BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "F_Localit.frx":23A2
Key = ""
EndProperty
EndProperty
End
Begin MSDBGrid.DBGrid DBGrid1
Bindings = "F_Localit.frx":4B54
Height = 2175
Left = 720
OleObjectBlob = "F_Localit.frx":4B6C
TabIndex = 7
Tag = "2"
Top = 3000
Width = 5295
End
Begin VB.Data DLocalite
Caption = "DLocalite"
Connect = "Access"
DatabaseName = "C:\Documents and Settings\cyrielle\Bureau\Projet_Stage_VB\Projet\Vers97.mdb"
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
EOFAction = 2 'Add New
Exclusive = 0 'False
Height = 345
Left = 480
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "TLocalite"
Top = 5280
Width = 5535
End
Begin VB.Frame Frame1
Caption = "Gestion des localités"
Height = 2055
Left = 1080
TabIndex = 0
Top = 720
Width = 4455
Begin VB.TextBox Text1
DataField = "NCodPos"
DataSource = "DLocalite"
DragMode = 1 'Automatic
Height = 375
Index = 0
Left = 1920
TabIndex = 1
Top = 240
Width = 1695
End
Begin VB.TextBox Text1
DataField = "Nlocalite"
DataSource = "DLocalite"
Height = 375
Index = 1
Left = 1920
TabIndex = 3
Top = 840
Width = 2055
End
Begin VB.TextBox Text1
DataField = "Pays"
DataSource = "DLocalite"
Height = 375
Index = 2
Left = 1920
TabIndex = 5
Top = 1440
Width = 1815
End
Begin VB.Label Label1
Caption = "Code postal :"
Height = 255
Left = 240
TabIndex = 6
Top = 360
Width = 1695
End
Begin VB.Label Label2
Caption = "Localité :"
Height = 375
Left = 240
TabIndex = 4
Top = 840
Width = 1215
End
Begin VB.Label Label3
Caption = "Pays :"
Height = 375
Left = 240
TabIndex = 2
Top = 1440
Width = 975
End
End
Begin MSComctlLib.ProgressBar ProgressBar1
Align = 2 'Align Bottom
Height = 255
Left = 0
TabIndex = 8
Top = 6270
Width = 7665
_ExtentX = 13520
_ExtentY = 450
_Version = 393216
Appearance = 1
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 315
Left = 0
TabIndex = 9
Top = 5955
Width = 7665
_ExtentX = 13520
_ExtentY = 556
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 4
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 2884
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 4939
MinWidth = 4939
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 5
Alignment = 1
TextSave = "10:23"
EndProperty
BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 6
Alignment = 1
TextSave = "29/08/2005"
EndProperty
EndProperty
End
Begin MSComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 660
Left = 0
TabIndex = 10
Top = 0
Width = 7665
_ExtentX = 13520
_ExtentY = 1164
ButtonWidth = 1032
ButtonHeight = 1005
Appearance = 1
ImageList = "ImageList1"
DisabledImageList= "ImageList1"
HotImageList = "ImageList1"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 11
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "btnPremier"
Object.ToolTipText = "Affiche le premier enregistrement"
Object.Tag = "Affiche le premier enregistrement"
ImageIndex = 1
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "btnPrécédent"
Object.ToolTipText = "Affiche l'enregistrement précédent celui en cours"
Object.Tag = "Affiche l'enregistrement précédent celui en cours"
ImageIndex = 2
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "btnSuivant"
Object.ToolTipText = "Affiche l'enregistrement suivant celui en cours"
Object.Tag = "Affiche l'enregistrement suivant celui en cours"
ImageIndex = 3
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "btnDernier"
Object.ToolTipText = "Affiche le dernier enregistrement"
Object.Tag = "Affiche le dernier enregistrement"
ImageIndex = 4
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "btnAjouter"
Object.ToolTipText = "Ajoute un nouvel enregistrement"
Object.Tag = "Ajoute un nouvel enregistrement"
ImageIndex = 5
EndProperty
BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "btnEditer"
Object.ToolTipText = "Modifie l'enregistrement en cours"
Object.Tag = "Modifie l'enregistrement en cours"
ImageIndex = 6
EndProperty
BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "btnValider"
Object.ToolTipText = "Valide l'opération d'édition ou de création en cours"
Object.Tag = "Valide l'opération d'édition ou de création en cours"
ImageIndex = 7
EndProperty
BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "btnSupprimer"
Object.ToolTipText = "Supprime l'enregistrement en cours"
Object.Tag = "Supprime l'enregistrement en cours"
ImageIndex = 8
EndProperty
BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "btnAnnuler"
Object.ToolTipText = "Annule l'opération d'édition ou de création en cours"
Object.Tag = "Annule l'opération d'édition ou de création en cours"
ImageIndex = 9
EndProperty
BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "btnRechercher"
Object.ToolTipText = "Recherche un enregistrement à partir d'une liste"
Object.Tag = "Recherche un enregistrement à partir d'une liste"
ImageIndex = 10
EndProperty
BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "btnTerminer"
Object.ToolTipText = "Ferme le formulaire en cours"
Object.Tag = "Ferme le formulaire en cours"
ImageIndex = 11
EndProperty
EndProperty
BorderStyle = 1
End
Begin VB.Menu mnuFichiers
Caption = "Fichier"
Begin VB.Menu mnuQuitter
Caption = "&Quitter"
Index = 11
Shortcut = ^Q
End
End
Begin VB.Menu enreg
Caption = "Enregistrements"
Begin VB.Menu mnuNavig
Caption = "&Premier"
Index = 1
End
Begin VB.Menu mnuNavig
Caption = "&Précédent"
Index = 2
End
Begin VB.Menu mnuNavig
Caption = "&Suivant"
Index = 3
End
Begin VB.Menu mnuNavig
Caption = "&Dernier"
Index = 4
End
Begin VB.Menu mnuSepar1
Caption = "-"
End
Begin VB.Menu mnuEdit
Caption = "&Ajouter"
Index = 5
End
Begin VB.Menu mnuEdit
Caption = "&Editer"
Index = 6
End
Begin VB.Menu mnuEdit
Caption = "&Valider"
Index = 7
End
Begin VB.Menu mnuSepar2
Caption = "-"
End
Begin VB.Menu mnuAction
Caption = "&Supprimer"
Index = 8
End
Begin VB.Menu mnuAction
Caption = "&Annuler"
Index = 9
End
Begin VB.Menu mnuSepar3
Caption = "-"
End
Begin VB.Menu mnuRechercher
Caption = "&Rechercher"
Index = 10
End
End
End
Attribute VB_Name = "F_Localit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim lgTotalRecords As Long
Dim lgTotalRecordsEC As Long
Dim iCurrentState As Integer
Dim ctrlDataEC As Object
'Public FlagValidate As Boolean
Public FlagErreur As Boolean
Public vNumLigne As Long


Private Sub DBGrid1_GotFocus()
With DBGrid1
.Col = "0"
.Row = "0"
End With
UpdateButtons
End Sub

Private Sub DBGrid1_LostFocus()
UpdateButtons
End Sub

Private Sub DLocalite_Reposition()
ProgressBar1.Value = DLocalite.Recordset.PercentPosition
lgTotalRecords = DLocalite.Recordset.RecordCount
StatusBar1.Panels.Item(1).Text = "Code Postal N° " & DLocalite.Recordset.AbsolutePosition + 1
StatusBar1.Panels.Item(2).Text = "Prêt..."
End Sub


Private Sub DLocalite_Validate(Action As Integer, Save As Integer)
'Vérifie les règles de saisie pour l'enregistrement principal
If (Action = vbDataActionUpdate) Then
If (Len(Text1(1)) = 0) Then
MsgBox ("Saisissez un nom de société")
'FlagValidate = True
Text1(1).SetFocus
Save = 0
Action = 0
End If
End If
End Sub

Private Sub Form_Activate()
'Parcourt la totalité du jeu d'enregistrements
'et compte le nombre d'enregistrements
StatusBar1.Panels.Item(2).Text = "Chargement..."
With DLocalite
.RecordSource = "select * from TLocalite order by NCodPos"
.Refresh
End With

End Sub

Private Sub Form_Load()
With DLocalite
.RecordSource = "select * from TLocalite order by NCodPos"
.Refresh
End With

With DLocalite.Recordset
.MoveLast
lgTotalRecords = .RecordCount
.MoveFirst
End With

UpdateButtons True
StatusBar1.Panels.Item(1).Text = "Code Postal N° " & DLocalite.Recordset.AbsolutePosition + 1
StatusBar1.Panels.Item(2).Text = "Prêt..."
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'Gère la fermeture du formulaire dans tous les cas
Dim intMessage As Integer

If (DLocalite.Recordset.EditMode <> dbEditNone) Then
intMessage = MsgBox("Vous devez terminer l'édition de l'enregistrement en cours", _
vbInformation, "Code Postal")
Cancel = True
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set F_Localit = Nothing
End Sub

Private Sub mnuAction_Click(intIndex As Integer)
Call Toolbar1_ButtonClick(Me.Toolbar1.Buttons.Item(intIndex))
End Sub

Private Sub mnuEdit_Click(intIndex As Integer)
Call Toolbar1_ButtonClick(Me.Toolbar1.Buttons.Item(intIndex))
End Sub

Private Sub mnuNavig_Click(intIndex As Integer)
Call Toolbar1_ButtonClick(Me.Toolbar1.Buttons.Item(intIndex))
End Sub

Private Sub mnuQuitter_Click(intIndex As Integer)
Call Toolbar1_ButtonClick(Me.Toolbar1.Buttons.Item(intIndex))
End Sub

Private Sub mnuRechercher_Click(intIndex As Integer)
Call Toolbar1_ButtonClick(Me.Toolbar1.Buttons.Item(intIndex))
End Sub

Private Sub Text1_GotFocus(Index As Integer)
'Appel de la procédure Highlight (mise en surbrillance) à réception du focus dans la contrôle
HighLight
End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
'Permet d'utiliser la touche Entrée comme une tabulation
If KeyAscii = vbKeyReturn Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Private Sub Text1_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
'Passe au champ suivant quand le champ en cours est totalement rempli
With Screen.ActiveForm
If (Len(.ActiveControl.Text) = .ActiveControl.MaxLength) Then
SendKeys "{Tab}"
End If
End With
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
'Détecte le bouton de commande utilisé

On Error GoTo ERREUR

Static vMyBookMark As Variant 'pour attribuer un signet à l'enregistrement courant

If Not (TypeOf Screen.ActiveForm.ActiveControl Is DBGrid) Then
Set ctrlDataEC = DLocalite
lgTotalRecordsEC = lgTotalRecords
End If

Select Case Button.Key 'Valeur du bouton de commande sur lequel l'utilisateur a cliqué
Case "btnPremier"
ctrlDataEC.Recordset.MoveFirst
Call UpdateButtons

Case "btnPrécédent"
ctrlDataEC.Recordset.MovePrevious
Call UpdateButtons

Case "btnSuivant"
ctrlDataEC.Recordset.MoveNext
Call UpdateButtons

Case "btnDernier"
ctrlDataEC.Recordset.MoveLast
Call UpdateButtons

Case "btnAjouter"
With ctrlDataEC.Recordset
If (.EditMode = dbEditNone) Then
If (lgTotalRecordsEC > 0) Then
vMyBookMark = .Bookmark
Else
vMyBookMark = ""
End If
DBGrid1.AllowAddNew = True 'Nécessaire si il y a eu annulation
.AddNew
Call UpdateButtons
StatusBar1.Panels.Item(2).Text = "Ajout d'un nouvel enregistrement..."
End If
End With

Case "btnAnnuler"
With ctrlDataEC.Recordset
If (.EditMode <> dbEditNone) Then
.CancelUpdate
If (Len(vMyBookMark)) Then
.Bookmark = vMyBookMark
End If
UpdateButtons True
StatusBar1.Panels.Item(2).Text = "Prêt..."
Else
.Move 0
End If
End With

Case "btnEditer"
With ctrlDataEC.Recordset
If (.EditMode = dbEditNone) Then
vMyBookMark = .Bookmark
.Edit
Call UpdateButtons
StatusBar1.Panels.Item(2).Text = "En cours d'édition..."
End If
End With

Case "btnValider"
Dim bMoveLast As Boolean
With ctrlDataEC.Recordset
If (.EditMode <> dbEditNone) Then
If .EditMode = dbEditAdd Then
bMoveLast = True
Else
bMoveLast = False
End If
.Update
If (.EditMode = dbEditNone) Then
'L'ajout ou l'édition se sont effectués correctement
If (bMoveLast = True) Then
.MoveLast
lgTotalRecordsEC = .RecordCount
Compter_Enregistrements
Else
.Move 0
End If
UpdateButtons True
End If
Else
.Move 0
End If
End With

Case "btnSupprimer"
Dim intResponse As Integer
Dim strMessage
strMessage = "Etes vous sûr de vouloir supprimer cet enregistrement?"
intResponse = MsgBox(strMessage, vbQuestion + vbYesNo + vbDefaultButton2, "Table Editeurs")
If (intResponse = vbYes) Then
With ctrlDataEC.Recordset
.Delete
lgTotalRecordsEC = .RecordCount
Compter_Enregistrements
If (lgTotalRecordsEC > 0) Then
If FlagErreur = False Then
If .BOF Then
.MoveFirst
Else
.MovePrevious
End If
Else
.Move 0
FlagErreur = False
End If
End If
End With
End If
Call UpdateButtons

Case "btnRechercher"
Dim iReturn As Integer
gFindString = ""
StatusBar1.Panels.Item(2).Text = "Recherche en cours..."

DoEvents

If (Len(gFindString) > 0) Then
With ctrlDataEC.Recordset
If Not .BOF True Or .EOF True Then
.FindFirst "[Name] = '" & gFindString & "' "
If (.NoMatch) Then
iReturn = MsgBox("Le Code Postal N° " & gFindString & _
" n'a pas été trouve.", vbCritical, "Editeur")
Else
iReturn = MsgBox("Le Code Postal N° " & gFindString & _
" a été extrait.", vbInformation, "Editeur")
End If
End If
End With
End If
UpdateButtons

Case "btnTerminer"
Unload Me

End Select

Exit Sub

ERREUR:
Select Case Err.Number
Case 5
MsgBox "btnclick"
Resume Next
Case 3200
'Enregistrements connexes
MsgBox "Il est impossible de supprimer cette fiche." & _
" car il y a au moins un enregistrement liés."
FlagErreur = True
Resume Next
Case 3426
'Evènement annulé par objet associé
Resume Next
Case Else
MsgBox ("Erreur n° " & Err.Number & " - Description: " & _
Err.Description & " - Source: " & Err.Source & _
" - Sub 5")
Resume Next
End Select
End Sub

Private Sub Compter_Enregistrements()
If Not (TypeOf Screen.ActiveForm.ActiveControl Is DBGrid) Then
lgTotalRecords = lgTotalRecordsEC
End If
End Sub

Public Sub UpdateButtons(Optional bLockEm As Variant, Optional ctrlDataEC As Object)
'Détermine quel est l'état du jeu d'enregistrement
'(aucune opération d'édition en cours)
'(édition en cours avec l'enregistrement courrant dans la mémoire tampon)
'(ajout d'un enregistrement avec un enregistrement vide en cours)

If Not (TypeOf Screen.ActiveForm.ActiveControl Is DBGrid) Then
Set ctrlDataEC = DLocalite
lgTotalRecordsEC = lgTotalRecords
End If

Select Case ctrlDataEC.Recordset.EditMode
Case dbEditNone 'pas d'edition en cours, gère simplement la navigation
If (lgTotalRecordsEC >= 2) Then
If (ctrlDataEC.Recordset.BOF) Or (ctrlDataEC.Recordset.AbsolutePosition = 0) Then
'Appelle de la procédure navigateButtons avec passage d'argument
'L'argument est une chaîne de 11 "0 ou 1" représentant l'état des 11 boutons de commandes

If (Me.ActiveControl.Tag <> "2") Then
navigateButtons ("00111101011")
Else
navigateButtons ("00111101001")
End If
ElseIf (ctrlDataEC.Recordset.EOF) Or (ctrlDataEC.Recordset.AbsolutePosition = lgTotalRecordsEC - 1) Then
If (Me.ActiveControl.Tag <> "2") Then
navigateButtons ("11001101011")
Else
navigateButtons ("11001101001")
End If
Else
If (Me.ActiveControl.Tag <> "2") Then
navigateButtons ("11111101011")
Else
navigateButtons ("11111101001")
End If
End If
ElseIf (lgTotalRecordsEC > 0) Then
navigateButtons ("00001101001")
Else
navigateButtons ("00001000001")
End If
If (Not IsMissing(bLockEm)) Then
lockTheControls (bLockEm)
End If
Case dbEditInProgress 'Modification de l'enregistrement courant en cours
Call lockTheControls(False)
If Not (TypeOf Me.ActiveControl Is DBGrid) Then
Text1(1).SetFocus
End If
navigateButtons ("00000010100")
Case dbEditAdd 'Ajout d'un nouvel enregistrement en cours
Call lockTheControls(False)
navigateButtons ("00000010100")
End Select
End Sub

Public Sub navigateButtons(strButtonString As String)
'Définition de l'activation des boutons de commandes
'par le biais de la chaîne transmise à strButtonsString
Dim intIndex As Integer
Dim intButtonLength As Integer

strButtonString = Trim$(strButtonString)
intButtonLength = Len(strButtonString)

For intIndex = 1 To intButtonLength
If (Mid$(strButtonString, intIndex, 1) = "1") Then
Toolbar1.Buttons(intIndex).Enabled = True
Toolbar1.Buttons(intIndex).Image = (intIndex)
Toolbar1.Buttons(intIndex).ToolTipText = Toolbar1.Buttons(intIndex).Tag
If intIndex <= 4 Then
mnuNavig.Item(intIndex).Enabled = True
ElseIf intIndex >= 5 And intIndex <= 7 Then
mnuEdit.Item(intIndex).Enabled = True
ElseIf intIndex = 8 And intIndex <= 9 Then
mnuAction.Item(intIndex).Enabled = True
ElseIf intIndex = 10 Then
mnuRechercher.Item(intIndex).Enabled = True
Else: intIndex = 11
mnuQuitter.Item(intIndex).Enabled = True
End If
Else
Toolbar1.Buttons(intIndex).Image = (intIndex + 11)
Toolbar1.Buttons(intIndex).Enabled = False
If Toolbar1.Buttons(intIndex).Image > 11 Then
Toolbar1.Buttons(intIndex).ToolTipText = "Non disponible"
End If
If intIndex <= 4 Then
mnuNavig.Item(intIndex).Enabled = False
ElseIf intIndex >= 5 And intIndex <= 7 Then
mnuEdit.Item(intIndex).Enabled = False
ElseIf intIndex >= 8 And intIndex <= 9 Then
mnuAction.Item(intIndex).Enabled = False
ElseIf intIndex = 10 Then
mnuRechercher.Item(intIndex).Enabled = False
Else: intIndex = 11
mnuQuitter.Item(intIndex).Enabled = False
End If
End If
Next
DoEvents
End Sub

Private Sub lockTheControls(blocked As Boolean)
'Définit le vérouillage des champs de type TextBox du formulaire.
'Le paramètre bLocked peut être à True (une validation ou une suppression est en cours),
'ou False (une édition ou un nouvele enregistrement est en cours),
'ou "rien" (navigation ou recherche en cours).

Dim intIndex As Integer

With Screen.ActiveForm
For intIndex = 0 To .Controls.Count - 1
'On parcours l'ensemble des controles du formulaire
If Not (TypeOf .ActiveControl Is DBGrid) Then
'Le contrôle actif n'est pas un DataGrid
If Not (TypeOf .Controls(intIndex) Is DBGrid) Then
'Le contrôle correspondant à l'index n'est pas un DataGrid
If (.Controls(intIndex).Tag = "1") Then
'Le contrôle correspondant à l'index est un des contrôle du
'groupe TextBox, sauf le premier (ID). On vérifie l'état de la machine
If (blocked) Then
'On est en mode navigation ou validation
.Controls(intIndex).Locked = True
.Controls(intIndex).BackColor = &HFFFF80
Else
'On est en mode édition ou ajout
.Controls(intIndex).Locked = False
.Controls(intIndex).BackColor = vbYellow
End If
End If
ElseIf (TypeOf .Controls(intIndex) Is DBGrid) Then
'Le contrôle correspondant à l'index est un DataGrid
DBGrid1.AllowUpdate = False
DBGrid1.BackColor = &HFFFF80
End If
ElseIf (TypeOf .ActiveControl Is DBGrid) Then
'Le contrôle actif est un DataGrid
If Not (TypeOf .Controls(intIndex) Is DBGrid) Then
'Le contrôle correspondant à l'index n'est pas un dataGrid
If (.Controls(intIndex).Tag = "1") Then
'Le contrôle correspondant à l'index est un des contrôles
'du groupe TextBox, sauf le premier (ID). On les désactive.
.Controls(intIndex).Locked = True
.Controls(intIndex).BackColor = &HFFFF80
If (blocked) Then
.Controls(intIndex).Enabled = True
Else
.Controls(intIndex).Enabled = False
End If
End If
ElseIf (TypeOf .Controls(intIndex) Is DBGrid) Then
'Le contrôle correspondant à l'index est un DbGrid.
'On vérifie alors l'état de la machine
If (blocked) Then
'On est en mode navigation ou validation. Le DataGrid est bloqué.
.Controls(intIndex).AllowAddNew = False
.Controls(intIndex).AllowDelete = False
.Controls(intIndex).AllowUpdate = False
.Controls(intIndex).BackColor = &HFFFF80
Else
'Un ajout ou une édition est en cours. Le DataGrid est débloqué.
If ctrlDataEC.Recordset.EditMode = dbEditInProgress Then
'C'est une édition
.Controls(intIndex).AllowUpdate = True
.Controls(intIndex).BackColor = vbYellow
ElseIf ctrlDataEC.Recordset.EditMode = dbEditAdd Then
'C'est un ajout
.Controls(intIndex).AllowUpdate = True
.Controls(intIndex).AllowAddNew = True
.Controls(intIndex).BackColor = vbYellow
End If
End If
End If
End If
Next
End With
End Sub

Public Sub HighLight()
'Met en surbrillance le contrôle actif
With Screen.ActiveForm
If (TypeOf .ActiveControl Is TextBox) Then
.ActiveControl.SelStart = 0
.ActiveControl.SelLength = Len(.ActiveControl)
End If
End With
End Sub


Voilà il y a du code aussi dans le module, j'ai voulu m'aider d'un autre programme mais apparemment ça ne va pas...

ET voici le code du module:
Attribute VB_Name = "Module2"

Option Explicit

Public Declare Function sendMessageByString& Lib "user32" _
Alias "SendMessageA" (ByVal hWnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lparam As String)

Public Const LB_SELECTSTRING = &H18C
Public gFindString As String
Public Const gDataBaseName = "c:\DidactDB\Biblio.mdb"

Public Sub HighLight()
'Met en surbrillance le contrôle actif

If (Not Screen.ActiveForm Is Nothing) Then
With Screen.ActiveForm
If (TypeOf .ActiveControl Is TextBox) Then
.ActiveControl.SelStart = 0
.ActiveControl.SelLength = Len(.ActiveControl)
End If
End With
End If

End Sub
0

Discussions similaires

Erreur 91 "Variable objet ou bloc with non définie" ???????
doomVB -
crenaud76 -

3 réponses
erreur 91 : variable non défini
Foggyboy -
Foggyboy -

2 réponses
Variable objet ou variable bloc with non défini
thulguer -
thulguer -

2 réponses
Variables dans un switch case
Utilisateur anonyme -
seedidg -

3 réponses
Erreur 91 : Variable objet ou variable bloc With non définie
fred.toto -
fred.toto -

2 réponses
Rejoignez-nous