Boite de dialogue qui s'affiche à répétition

superfri Messages postés 10 Date d'inscription lundi 11 décembre 2006 Statut Membre Dernière intervention 30 septembre 2011 - 25 oct. 2009 à 11:28
superfri Messages postés 10 Date d'inscription lundi 11 décembre 2006 Statut Membre Dernière intervention 30 septembre 2011 - 26 oct. 2009 à 09:25
slt j'ai uu problème dans mon code. Lorsque je l'écrit et que je suis sur la plate forme y a pas de problème; mais lorsque je crée l'exécutable les msgbox s'affiche deux fois et je ne comprend pas pourquoi.
merci de m'aider et voici l'esprit de mon code en général.
'code d'un formulaire
VERSION 5.00
Object = "{08B3208E-82F1-49FF-A798-F3156F86B73E}#33.0#0"; "Rey_XpBasics.ocx"
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
Begin VB.Form enrecause
BackColor = &H00E0E0E0&
Caption = "Cause Probable"
ClientHeight = 3975
ClientLeft = 60
ClientTop = 450
ClientWidth = 6585
Icon = "enrecause.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 3975
ScaleWidth = 6585
StartUpPosition = 2 'CenterScreen
Begin VB.PictureBox Picture1
BorderStyle = 0 'None
Height = 615
Left = 240
Picture = "enrecause.frx":0CCA
ScaleHeight = 615
ScaleWidth = 6015
TabIndex = 0
Top = 120
Width = 6015
End
Begin MSAdodcLib.Adodc Adodc1
Height = 330
Left = 960
Top = 3840
Visible = 0 'False
Width = 2895
_ExtentX = 5106
_ExtentY = 582
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
Caption = "Adodc1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin Rey_XpBasics.ReyFrame ReyFrame1
Height = 1815
Left = 240
TabIndex = 1
Top = 1920
Width = 4935
_ExtentX = 8705
_ExtentY = 3201
BackColor = -2147483633
Caption = "liste de données"
Begin MSDataGridLib.DataGrid DataGrid1
Height = 1335
Left = 240
TabIndex = 2
Top = 360
Width = 4575
_ExtentX = 8070
_ExtentY = 2355
_Version = 393216
AllowUpdate = 0 'False
HeadLines = 1
RowHeight = 15
BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ColumnCount = 2
BeginProperty Column00
DataField = ""
Caption = ""
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1036
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column01
DataField = ""
Caption = ""
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1036
SubFormatType = 0
EndProperty
EndProperty
SplitCount = 1
BeginProperty Split0
BeginProperty Column00
EndProperty
BeginProperty Column01
EndProperty
EndProperty
End
End
Begin Rey_XpBasics.ReyCommand reycomenre
Height = 495
Left = 5280
TabIndex = 3
ToolTipText = "enregistrer "
Top = 1560
Width = 1095
_ExtentX = 1931
_ExtentY = 873
Caption = "&Enregistrer"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin Rey_XpBasics.ReyBarElement ReyBarElement2
Height = 300
Left = 240
TabIndex = 4
Top = 1440
Width = 1815
_ExtentX = 3201
_ExtentY = 529
MaskColor = 0
Caption = "Libelle Cause Probable"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin Rey_XpBasics.ReyCommand reycommodifier
Height = 495
Left = 5280
TabIndex = 5
ToolTipText = "modifier "
Top = 2160
Width = 1095
_ExtentX = 1931
_ExtentY = 873
Caption = "&Modifier"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin Rey_XpBasics.ReyCommand reycomquitter
Height = 495
Left = 5280
TabIndex = 6
ToolTipText = "quitter"
Top = 2760
Width = 1095
_ExtentX = 1931
_ExtentY = 873
Caption = "&Quitter"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BackColor = -2147483629
End
Begin Rey_XpBasics.ReyTextBox rtxtbLibelle
Height = 255
Left = 2640
TabIndex = 7
ToolTipText = "libelle "
Top = 1440
Width = 2175
_ExtentX = 3836
_ExtentY = 450
Text = ""
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin Rey_XpBasics.ReyCommand reycomnouveau
Height = 495
Left = 5280
TabIndex = 8
ToolTipText = "réinitialisation des champs"
Top = 960
Width = 1095
_ExtentX = 1931
_ExtentY = 873
Caption = "&Nouveau"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin Rey_XpBasics.ReyCommand ReycommSupprimer
Height = 495
Left = 5280
TabIndex = 9
ToolTipText = "supprimer"
Top = 2760
Width = 1095
_ExtentX = 1931
_ExtentY = 873
Caption = "&Supprimer"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin Rey_XpBasics.ReyTextBox rtextbCode
Height = 255
Left = 2640
TabIndex = 10
ToolTipText = "code "
Top = 960
Width = 495
_ExtentX = 873
_ExtentY = 450
Text = ""
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
TabSize = 2
End
Begin Rey_XpBasics.ReyBarElement ReyBarElement1
Height = 300
Left = 240
TabIndex = 11
Top = 960
Width = 1815
_ExtentX = 3201
_ExtentY = 529
MaskColor = 0
Caption = "Code Cause Probable"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
End
Attribute VB_Name = "enrecause"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim str, str1 As String

Private Sub DataGrid1_Click()

On Error GoTo handler
reycomnouveau.Enabled = True
reycomenre.Enabled = False
reycommodifier.Enabled = True
ReycommSupprimer.Enabled = True
rtextbCode.Enabled = False

If Adodc1.Recordset.BOF True And Adodc1.Recordset.EOF True Then
MsgBox ("pas de cause probable enregistrée"), vbOKOnly
Else

rtextbCode.Text = Adodc1.Recordset!codecp
rtxtbLibelle.Text = Adodc1.Recordset!LibelleCP
End If
handler:
For Each adoer In cnn.Errors
MsgBox adoer.Description
Next
End Sub

Private Sub Form_Load()

ConnectBD 'permet de me connecter à la bd
compte
reycomenre.Enabled = False
reycommodifier.Enabled = False
reycomnouveau.Enabled = False
ReycommSupprimer.Enabled = False
rtextbCode.Enabled = False

'chargement de la liste
Adodc1.ConnectionString = cnn.ConnectionString
Adodc1.RecordSource = "select Codecp, Libellecp from causeprobable order by Codecp asc"
Set DataGrid1.DataSource = Adodc1
'fin chargement

End Sub

Private Sub reycomenre_Click()

If rtextbCode.Text = "" Then
MsgBox "ce champ code ne doit pas être vide"
rtextbCode.SetFocus
reycomenre.Enabled = False
Exit Sub
End If

If rtxtbLibelle.Text = "" Then
MsgBox "ce champ ne doit pas être vide"
rtxtbLibelle.SetFocus
reycomenre.Enabled = False
Exit Sub
End If

If Len(rtextbCode.Text) <> 4 Then
MsgBox "ce champ prend 4 caractères!!!!", vbCritical
rtextbCode.SetFocus
reycomenre.Enabled = False
Exit Sub
End If

If Len(rtxtbLibelle.Text) > 50 Then
MsgBox "ce champ doit contenir au plus 50 caractères exclusivement!!!!"
reycommodifier.Enabled = False
Exit Sub
End If

Set rsado1 = New Recordset
rsado1.Open "select * from causeprobable where codecp='" & rtextbCode.Text & "' or Libellecp = '" & DoubleQuote(rtxtbLibelle.Text) & "'", cnn, adOpenStatic, adLockOptimistic
If rsado1.RecordCount <> 0 Then
MsgBox "Vérifier code ou libellé !", vbCritical
Exit Sub
End If

Set rsado1 = New Recordset

rsado1.Open "insert into causeprobable values('" & rtextbCode.Text & "' , '" & LCase(DoubleQuote(rtxtbLibelle.Text)) & "')", cnn, adOpenDynamic, adLockOptimistic
MsgBox "Enregistrement effectué !", vbInformation
Adodc1.Refresh
reycommodifier.Enabled = False
reycomenre.Enabled = False
reycomnouveau.Enabled = False
compte
rtxtbLibelle.Text = ""
rtxtbLibelle.SetFocus

End Sub

Private Sub reycommodifier_Click()

If rtextbCode.Text = "" Then
MsgBox "ce champ code ne doit pas être vide"
rtextbCode.SetFocus
reycommodifier.Enabled = False
Exit Sub
End If

If rtxtbLibelle.Text = "" Then
MsgBox "ce champ ne doit pas être vide"
rtxtbLibelle.SetFocus
reycommodifier.Enabled = False
Exit Sub
End If

Set rsado1 = New Recordset

rsado1.Open "update causeprobable set libellecp= '" & LCase(DoubleQuote(rtxtbLibelle.Text)) & "' where codecp='" & rtextbCode.Text & "'", cnn, adOpenDynamic, adLockOptimistic
MsgBox "Opération effectué !", vbInformation
Adodc1.Refresh
reycommodifier.Enabled = False
rtextbCode.Text = ""
rtxtbLibelle.Text = ""

End Sub

Private Sub reycomnouveau_Click()

rtextbCode.Text = ""
rtxtbLibelle.Text = ""
rtextbCode.Enabled = True
compte

End Sub

Private Sub reycomquitter_click()
Unload Me
End Sub

Private Sub rtxtbLibelle_Change()

reycomenre.Enabled = True
If rtxtbLibelle.Text = "" Then
reycomenre.Enabled = False
End If

If IsNumeric(rtxtbLibelle.Text) Then
MsgBox "ce champ n'est pas numérique", vbOKOnly
rtxtbLibelle.SetFocus
End If
End Sub

Private Sub compte()
Set rsado1 = New Recordset
rsado1.Open "select * from causeprobable", cnn, adOpenStatic, adLockReadOnly
With rsado1
If .RecordCount = 0 Then
rtextbCode.Text = "B.01"
Else
str1 = .RecordCount + 1
If str1 < 10 Then
str = "B.0"
rtextbCode.Text = str & str1
Else
If str1 >= 10 Then
str = "B."
rtextbCode.Text = str & str1
End If
End If
End If
End With
End Sub

3 réponses

jmf0 Messages postés 1566 Date d'inscription mardi 26 décembre 2000 Statut Membre Dernière intervention 5 avril 2013 8
25 oct. 2009 à 11:48
Slt,

J'ai essayé de lire ton code et ai le tournis !
Veux-tu bien faire l'effort de l'indenter et utiliser les balises code, s'il te plait ?
Merci.
0
cboulas Messages postés 2641 Date d'inscription mercredi 2 juin 2004 Statut Membre Dernière intervention 8 janvier 2014 16
25 oct. 2009 à 11:49
Hello,

si je ne m'abuse tu dev. en VB6 voir plus ancien.
juste pour complétez ta demande, laquekke de tes msgbox s'affiche plusieurs fois ?

Chris...Web : Firstruner
0
superfri Messages postés 10 Date d'inscription lundi 11 décembre 2006 Statut Membre Dernière intervention 30 septembre 2011
26 oct. 2009 à 09:25
dans le sub enregistrer; lorsque l'enregistrement s'effectue la boite de dialogue de test de doublon dans le même sub se raffiche
dans le sub modifier la boite opération effectuée s'affiche deux fois.
c'est donc comme ci le programme s'exécute et revient afficher ces boites respectivement.
excusé de trop de code je voulais vous donnez tous les détails possibles car je me suis dit peut-être que c'est au niveau de la config ou d'une dll mais je ne sais qui ou quoi?
merci
0
Rejoignez-nous