Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Access Test d'intégrité du code VBA

Test d'intégrité du code VBA

8 réponses
Avatar
Tony Bouquet
Hello tous le monde.
Suite à mon autre post, ayant un soupçon de corruption avec une base A97, je
recherche un moyen de tester l'intègrité du code VBA et de contrôler les
formulaires.
Est-ce que cela existe ?
Par avance merci et bonne soirée
Tony Bouquet
Signaler un problème avec ce contenu

8 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
3stone
Salut,

"Tony Bouquet"
| Suite à mon autre post, ayant un soupçon de corruption avec une base A97, je
| recherche un moyen de tester l'intègrité du code VBA et de contrôler les
| formulaires.
| Est-ce que cela existe ?


Ta base compile correctement ?

Si oui, mais que tu garde un doute sérieux à cause de certains comportements
bizarres, fait un /decompile
http://www.trigeminal.com/usenet/usenet004.asp?1036

Sinon, tu peux aussi créer une base vide et importer l'ancienne via le menu
Fichier, Données externes, Importer...


Le /decompile est à utiliser si tu doute du code...
L'import est plutôt destiné à éliminer un formulaire corrompu.


--
A+
Pierre (3stone) Access MVP
Perso: http://www.3stone.be/
Conseils MPFA: http://www.mpfa.info/
Avatar
Tony Bouquet
Hello 3stone
mci pour l'info, j'ai déja fait cela mais au bout de quelques modif dans mes
formulaires, j'ai un message d'erreur quand je compile "MSAccess à généré
une erreur ect..."
Je réimporte le formulaire d'une sauvegarde, et cela refonctionne pendant un
certain temps.
Pour le moment je travaille comme cela mais j'aimerais bien découvrir ce qui
me fait corrompre ma base !
Bonne journée
T. Bouquet


"3stone" a écrit dans le message de news:

Salut,

"Tony Bouquet"
| Suite à mon autre post, ayant un soupçon de corruption avec une base
A97, je
| recherche un moyen de tester l'intègrité du code VBA et de contrôler les
| formulaires.
| Est-ce que cela existe ?


Ta base compile correctement ?

Si oui, mais que tu garde un doute sérieux à cause de certains
comportements
bizarres, fait un /decompile
http://www.trigeminal.com/usenet/usenet004.asp?1036

Sinon, tu peux aussi créer une base vide et importer l'ancienne via le
menu
Fichier, Données externes, Importer...


Le /decompile est à utiliser si tu doute du code...
L'import est plutôt destiné à éliminer un formulaire corrompu.


--
A+
Pierre (3stone) Access MVP
Perso: http://www.3stone.be/
Conseils MPFA: http://www.mpfa.info/





Avatar
3stone
re,

"Tony Bouquet"
| mci pour l'info, j'ai déja fait cela


Tu as fait un /decompile ?

En utilisation "normale", un formulaire ne doit pas se corrompre,
à moins de code vraiment... spécial.
Cela se passe plutôt lorsque l'on développe par série de "test/correction"


--
A+
Pierre (3stone) Access MVP
Perso: http://www.3stone.be/
Conseils MPFA: http://www.mpfa.info/
Avatar
Tony Bouquet
Hello 3stone
Oui j'ai fait /decompile et après c'était ok.
Ensuite après plusieurs modif dans le code du formulaire, rebelotte msg
d'erreur lors de la compilation.
Bonne journée
T. Bouquet

"3stone" a écrit dans le message de news:

re,

"Tony Bouquet"
| mci pour l'info, j'ai déja fait cela


Tu as fait un /decompile ?

En utilisation "normale", un formulaire ne doit pas se corrompre,
à moins de code vraiment... spécial.
Cela se passe plutôt lorsque l'on développe par série de "test/correction"


--
A+
Pierre (3stone) Access MVP
Perso: http://www.3stone.be/
Conseils MPFA: http://www.mpfa.info/



Avatar
Bonjour

tu n'avais pas dit jusqu'à présent (me souviens-je) que le pb survenait
"après modif dans le CODE du formulaire"

je pensais que c'était en fonctionnement NORMAL sous access97

Une erreur de compilation est liée à un problème de références.
Donc tu si tu utilises DAO, poste le code employé, tu libères peut-être mal les déclarations préalables.

Quel message exactement déjà quand tu as une erreur de compilation ?

Ta base n'est pas ouverte par quelqu'un d'autre quand tu fais tes modifs ?

Tu ne fais pas des modifs avec la base sur un lecteur réseau au lieu de lecteur local ?

a+
--
Arnaud
-----------------------------------------
Vous êtes novice ? :
http://www.mpfa.info
-----------------------------------------



"Tony Bouquet" a écrit dans le message de news:
Hello 3stone
Oui j'ai fait /decompile et après c'était ok.
Ensuite après plusieurs modif dans le code du formulaire, rebelotte msg d'erreur lors de la compilation.
Bonne journée
T. Bouquet

"3stone" a écrit dans le message de news:
re,

"Tony Bouquet"
| mci pour l'info, j'ai déja fait cela


Tu as fait un /decompile ?

En utilisation "normale", un formulaire ne doit pas se corrompre,
à moins de code vraiment... spécial.
Cela se passe plutôt lorsque l'on développe par série de "test/correction"


--
A+
Pierre (3stone) Access MVP
Perso: http://www.3stone.be/
Conseils MPFA: http://www.mpfa.info/







Avatar
Tony Bouquet
Hello
Base modifiée en local, pas d'autre utilisateurs (Ouverture en exclusif)
Msg d'erreur, "MSAccess a provoqué une erreur et doit être fermé..." module
concerné VBA332.dll.
Encore mci pour votre aide et bon weekend
Ciao Tony

Code dans ce formulaire:

Public Sub TestLimite()
'Test limite de crédit
If Me![IdClient].Column(4) = 0 Then
Else
If Me![Total_Facture] > Me![IdClient].Column(4) Then
Msg = "Attention limite de crédit atteinte"
Titre = "Assyst by MCB"
MsgBox Msg, , Titre
Else
End If
End If
End Sub

Private Sub ArtCD_AfterUpdate()
If Me!ArtCD = True Then
[Sfrm_Facture_Introduction].Form![NArticle].RowSource = "reqAjoutArtCD"
Else
[Sfrm_Facture_Introduction].Form![NArticle].RowSource = "reqAjoutArt"
End If
End Sub

Private Sub Bouton_Etats_Click()
On Error GoTo Err_Bouton_Etats_Click
'DoCmd.Echo False
Dim ChZoom
Dim DocName As String
Me.Recalc

Me!Total_TVA = Me!Montant_TVA
'Test si est arrondi
If [ArrondirA] = False Then
Me!Total_Facture = Me!TotalFacture
End If
Me.Recalc
DoCmd.RunCommand acCmdSaveRecord

If Me!Leasing = True Then
DocName = "rep_FactureLease"
Else
DocName = "rep_Facture"
End If

DoCmd.OpenReport DocName, A_PREVIEW, , "[Ref_Facture] =
Forms![frm_Facture]![Ref_Facture]"
ChZoom = Zoom
DoCmd.RunCommand ChZoom

Set ChZoom = Nothing

Exit_Bouton_Etats_Click:
DoCmd.Echo True
Exit Sub

Err_Bouton_Etats_Click:
'MsgBox Error$
Resume Exit_Bouton_Etats_Click

End Sub

Private Sub Bouton_Imprimer_Click()
On Error GoTo Err_Bouton_Imprimer_Click

Dim rep As String
Dim DocName As String
DoCmd.Echo False

If Forms!frm_Facture!Leasing = True Then
rep = "rep_FactureLease"
Else
rep = "rep_Facture"
End If

If Forms!frm_Facture!EstImprimer = False Then

Dim CountPrint, Tmp As Integer
Forms!frm_Facture.Recalc

'Date facture
If Forms!frm_Reference!DFacture = True And Forms!frm_Facture!EstImprimer
= False Then
Forms!frm_Facture!Date_Facture = Date
DoCmd.GoToControl "Choix_Echeance"
DoCmd.GoToControl "Commande"
Forms!frm_Facture![Echeance_Facture] =
Forms!frm_Facture![Date_Facture] + Forms!frm_Facture![Choix_Echeance]
End If

Forms!frm_Facture!Total_TVA = Forms!frm_Facture!Montant_TVA
'Test si est arrondi
If [ArrondirA] = False Then
Forms!frm_Facture!Total_Facture = Forms!frm_Facture!TotalFacture
End If
Forms!frm_Facture.Recalc
DoCmd.RunCommand acCmdSaveRecord

Msg = "Nb. copie pour impression?"
Titre = "Assyst by MCB"
DéfValeur = Forms!frm_Reference!NbPrinter
Tmp = InputBox(Msg, Titre, DéfValeur)
CountPrint = 0
Do While CountPrint < Tmp
DoCmd.OpenReport rep, , , "[Ref_Facture] =
Forms![frm_Facture]![Ref_Facture]"
CountPrint = CountPrint + 1
Loop
DoCmd.Close A_REPORT, rep
Forms!frm_Facture!EstImprimer = True ' Valide controle impression
Set CountPrint = Nothing

'Impression BV
If Forms!frm_Reference!PrintBV = True Then
If [Forms]![frm_Reference]![BVR] = True Then
If [Forms]![frm_Reference]![BVRA4] = True Then
DocName = "rep_Bulletin_BVRA4"
Else
DocName = "rep_Bulletin_BVR"
End If
Else
DocName = "rep_Bulletin_Versement"
End If
DoCmd.OpenReport DocName, , , "[Ref_Facture] =
Forms![frm_Facture]![Ref_Facture]"
DoCmd.Close A_REPORT, DocName
End If
Else
Const MB_OK = 0, MB_OKANNULER = 1 ' Définit les boutons.
Const MB_OUINONANNULER = 3, MB_OUINON = 4
Const MB_ICONSTOP = 64, MB_ICONQUESTION = 32 ' Définit les icônes.
Const MB_ICONEXCLAMATION = 48, MB_ICONINFORMATION = 64
Const MB_DEFBOUTON2 = 256, IDOUI = 6, IDNON = 7 ' Autres définitions.
Titre = "Assyst by MCB"
Msg = "Attention, facture déja imprimée. " & Chr(10)
Msg = Msg & "Voulez-vous quand-même l'imprimer? "
DéfBD = MB_OUINON + MB_ICONSTOP + MB_DEFBOUTON2 ' Décrit la boîte de
dialogue.
Réponse = MsgBox(Msg, DéfBD, Titre) ' Retourne la réponse de
l'utilisateur.
If Réponse = IDOUI Then ' Evalue la réponse
DoCmd.OpenReport rep, , , "[Ref_Facture] =
Forms![frm_Facture]![Ref_Facture]"
End If
End If

Exit_Bouton_Imprimer_Click:
DoCmd.Echo True
Exit Sub

Err_Bouton_Imprimer_Click:
MsgBox Error$
Resume Exit_Bouton_Imprimer_Click

End Sub

Private Sub Bouton_Sortie_Click()
On Error GoTo Err_Bouton_Sortie_Click

DoCmd.Echo False
Grp = 0 'Variable groupe
DoCmd.Close
DoCmd.Maximize

Exit_Bouton_Sortie_Click:
DoCmd.Echo True
Exit Sub

Err_Bouton_Sortie_Click:
MsgBox Error$
Resume Exit_Bouton_Sortie_Click

End Sub

Private Sub Bouton_Valider_Click()
On Error GoTo Err_Bouton_Valider_Click
MonName = ""
Dim Lim As Double
DoCmd.Echo False
Me.Recalc
Me!Total_TVA = Me!Montant_TVA

'Test si est arrondi
If [ArrondirA] = True Then
Const MB_OK = 0, MB_OKANNULER = 1 ' Définit les boutons.
Const MB_OUINONANNULER = 3, MB_OUINON = 4
Const MB_ICONSTOP = 64, MB_ICONQUESTION = 32 ' Définit les icônes.
Const MB_ICONEXCLAMATION = 48, MB_ICONINFORMATION = 64
Const MB_DEFBOUTON2 = 256, IDOUI = 6, IDNON = 7 ' Autres définitions.
Titre = "Assyst by MCB"
Msg = "Voulez-vous supprimer l'arrondi volontaire" & vbCrLf
Msg = Msg & "de cette facture ? "
DéfBD = MB_OUINON + MB_ICONSTOP + MB_DEFBOUTON2 ' Décrit la boîte de
dialogue.
Réponse = MsgBox(Msg, DéfBD, Titre) ' Retourne la réponse de
l'utilisateur.
If Réponse = IDOUI Then ' Evalue la réponse
Me!Total_Facture = Me!TotalFacture
Me!ArrondirA = False
Else
Msg = "Introduisez nouvel arrondi" & vbCrLf
Msg = Msg & "et valider par le bouton arrondi volontaire !"
Titre = "Assyst by MCB"
MsgBox Msg, , Titre
End If
Else
Me!Total_Facture = Me!TotalFacture
End If

If IsNull([Date_Cloture]) Then
Date_Cloture.BackColor = RGB(255, 0, 0)
Else
Date_Cloture.BackColor = RGB(0, 255, 0)
End If

DoCmd.RunCommand acCmdSaveRecord

'Test Limite crédit
Lim = TestLimit
If Lim <> 0 Then
Msg = "Attention, limite de crédit dépassée" & vbCrLf
Msg = Msg & "" & vbCrLf
Msg = Msg & "de : " & Format(Lim, "#,##0.00") & " Frs."
Titre = "Assyst by MCB"
MsgBox Msg, 48, Titre
End If

Exit_Bouton_Valider_Click:
DoCmd.Echo True
Exit Sub

Err_Bouton_Valider_Click:
MsgBox Error$
Msg = "N° de référence du document déja utilisé!" & vbCrLf
Msg = Msg & "Veuillez changer de n° svp."
Titre = "Assyst by MCB"
MsgBox Msg, 48, Titre
Resume Exit_Bouton_Valider_Click

End Sub

Private Sub Bouton304_Click()
On Error GoTo Err_Bouton304_Click

DoCmd.Echo False
Dim ChZoom
Dim DocName As String
Me.Recalc

Me!Total_TVA = Me!Montant_TVA
'Test si est arrondi
If [ArrondirA] = False Then
Me!Total_Facture = Me!TotalFacture
End If
Me.Recalc
DoCmd.RunCommand acCmdSaveRecord

DocName = "rep_Bulletin_Livraison"
DoCmd.OpenReport DocName, A_PREVIEW, , "[Ref_Facture] =
Forms![frm_Facture]![Ref_Facture]"
ChZoom = Zoom
DoCmd.RunCommand ChZoom

Set ChZoom = Nothing

Exit_Bouton304_Click:
DoCmd.Echo True
Exit Sub

Err_Bouton304_Click:
MsgBox Error$
Resume Exit_Bouton304_Click

End Sub

Private Sub Bouton305_Click()
On Error GoTo Err_Bouton305_Click

DoCmd.Echo False
Me.Recalc

Me!Total_TVA = Me!Montant_TVA
'Test si est arrondi
If [ArrondirA] = False Then
Me!Total_Facture = Me!TotalFacture
End If
Me.Recalc
DoCmd.RunCommand acCmdSaveRecord

DoCmd.OpenReport "rep_Bulletin_Livraison", 0, , "[Ref_Facture] =
Forms![frm_Facture]![Ref_Facture]"
DoCmd.Close A_REPORT, "rep_Bulletin_Livraison"

Exit_Bouton305_Click:
DoCmd.Echo True
Exit Sub

Err_Bouton305_Click:
MsgBox Error$
Resume Exit_Bouton305_Click

End Sub

Private Sub Bouton306_Click()
On Error GoTo Err_Bouton306_Click

'DoCmd.Echo False
Dim DocName As String
Me.Recalc

Me!Total_TVA = Me!Montant_TVA
'Test si est arrondi
If [ArrondirA] = False Then
Me!Total_Facture = Me!TotalFacture
End If

Me.Recalc
DoCmd.RunCommand acCmdSaveRecord

If [Forms]![frm_Reference]![BVR] = True Then
If [Forms]![frm_Reference]![BVRA4] = True Then
DocName = "rep_Bulletin_BVRA4"
Else
DocName = "rep_Bulletin_BVR"
End If
Else
DocName = "rep_Bulletin_Versement"
End If

DoCmd.OpenReport DocName, acPreview, , "[Ref_Facture] =
Forms![frm_Facture]![Ref_Facture]"
ChZoom = Zoom
DoCmd.RunCommand ChZoom

Set ChZoom = Nothing

Exit_Bouton306_Click:
DoCmd.Echo True
Exit Sub

Err_Bouton306_Click:
'MsgBox Error$
Resume Exit_Bouton306_Click

End Sub

Private Sub Bouton307_Click()
On Error GoTo Err_Bouton307_Click

DoCmd.Echo False
Dim DocName As String
Me.Recalc

Me!Total_TVA = Me!Montant_TVA

'Test si est arrondi
If [ArrondirA] = False Then
Me!Total_Facture = Me!TotalFacture
End If

Me.Recalc
DoCmd.RunCommand acCmdSaveRecord

If [Forms]![frm_Reference]![BVR] = True Then
If [Forms]![frm_Reference]![BVRA4] = True Then
DocName = "rep_Bulletin_BVRA4"
Else
DocName = "rep_Bulletin_BVR"
End If
Else
DocName = "rep_Bulletin_Versement"
End If

DoCmd.OpenReport DocName, , , "[Ref_Facture] =
Forms![frm_Facture]![Ref_Facture]"
DoCmd.Close acReport, DocName, acSaveNo

Exit_Bouton307_Click:
DoCmd.Echo True
Exit Sub

Err_Bouton307_Click:
'MsgBox Error$
Resume Exit_Bouton307_Click

End Sub

Private Sub Bouton337_Click()
On Error GoTo Err_Bouton337_Click
DoCmd.Echo False
Me.Recalc

Me!ArrondirA = True
Me!Total_TVA = Me!Montant_TVA

'Test Limite crédit
'TestLimite
DoCmd.RunCommand acCmdSaveRecord
DoCmd.Echo True

Exit_Bouton337_Click:
DoCmd.Echo True
Exit Sub

Err_Bouton337_Click:
MsgBox Error$
Resume Exit_Bouton337_Click

End Sub

Private Sub CallHelp_Click()
DemandeAide Me, "frm_facture"
End Sub

Private Sub Choix_Echeance_AfterUpdate()
If Me![Choix_Echeance] = 0 Then
Me![Echeance_Facture] = Me![Date_Facture]
Me![TypePaiement] = 6
Else
Me![Echeance_Facture] = Me![Date_Facture] + Me![Choix_Echeance]
End If
End Sub

Private Sub Choix_Groupe_AfterUpdate()
Dim ctlListe As Control
Set ctlListe = Me![Choix_Groupe]
ctlListe.Requery
Set ctlListe = Forms!frm_Facture!Sfrm_Facture_Introduction.Form!NArticle
ctlListe.Requery
Set ctlListe = Forms!frm_Facture!Sfrm_Facture_Introduction.Form!Libelle
ctlListe.Requery
Me.Recalc
Set ctlListe = Nothing
End Sub

Private Sub CodeTVA_AfterUpdate()
Dim X
If Not IsNull(Me![CodeTVA].Column(0)) Then
X = Me![CodeTVA].Column(2)
Me![TVA] = X
Else
End If
Me.Recalc
End Sub


Private Sub ComCli_AfterUpdate()
On Error GoTo Err_ComCli_Click

'Reprend données ComCli
Dim MaBase As Database
Dim livr As Recordset
Dim Temp
Dim MonSQL, Tmp, Tmp2 As String
Set MaBase = CurrentDb()

Const MB_OK = 0, MB_OKANNULER = 1 ' Définit les boutons.
Const MB_OUINONANNULER = 3, MB_OUINON = 4
Const MB_ICONSTOP = 64, MB_ICONQUESTION = 32 ' Définit les icônes.
Const MB_ICONEXCLAMATION = 48, MB_ICONINFORMATION = 64
Const MB_DEFBOUTON2 = 256, IDOUI = 6, IDNON = 7 ' Autres définitions.
Titre = "Assyst by MCB"
Msg = "Voulez-vous ajouter une ComCli à la facture?" & Chr(10)
DéfBD = MB_OUINON + MB_ICONSTOP + MB_DEFBOUTON2 ' Décrit la boîte de
dialogue.
Réponse = MsgBox(Msg, DéfBD, Titre) ' Retourne la réponse de l'utilisateur.
If Réponse = IDOUI Then ' Evalue la réponse
'Met à jour IdClient selon devis
Temp = Me![ComCli].Column(2)
Me![IdClient] = Temp

Forms![frm_Facture]![Sfrm_Facture_Introduction].[Form].Visible = True

'Met focus sur IdClient
DoCmd.GoToControl "IdClient"
DoCmd.GoToControl "Ref_Facture"
Forms![frm_Facture]![Sfrm_Facture_Introduction].[Form].Visible = True
'Crée l'instruction SELECT pour rechercher contrôle Concerne et RabaisT
du Devis
MonSQL = "SELECT DISTINCTROW [Ref_Facture], [Date_Facture], [Concerne],
[RabaisT], [Escompte], [Prorata], [Taux_TVA], [CodeTVA], [Frais_Port],
[TypePaiement] FROM tblComCli "
MonSQL = MonSQL & "WHERE [Ref_Facture] = '" &
Forms![frm_Facture]![ComCli] & "';"
Set livr = MaBase.OpenRecordset(MonSQL, DB_READONLY)
livr.MoveFirst
Me!Concerne = livr!Concerne
Me!Taux_TVA = livr!Taux_TVA
Me!RabaisT = livr!RabaisT
Me!Escompte = livr!Escompte
Me!Prorata = livr!Prorata
Me!CodeTVA = livr!CodeTVA
Me!Frais_Port = livr!Frais_Port
Me!TypePaiement = livr!TypePaiement

'Mise à jours délais paiement
Me!Choix_Echeance = Me![TypePaiement].Column(2)
Me![Echeance_Facture] = Me![Date_Facture] + Me![Choix_Echeance]

Tmp = Format(livr!Date_Facture, "dd mm yy")
Tmp2 = livr!Ref_Facture
If Me!Origine = "" Then
Me!Origine = "ComCli n°" & Tmp2 & " du " & Tmp & vbCrLf
Else
Me!Origine = Me!Origine & "ComCli n°" & Tmp2 & " du " & Tmp & vbCrLf
End If

livr.Close
DoCmd.SetWarnings False
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
DoCmd.OpenQuery "reqComCliAjouter" 'Ajoute ComCli
DoCmd.Requery "Sfrm_Facture_Introduction" 'Actualise (Shift + F9)
DoCmd.OpenQuery "reqMiseJourComCli" 'Mets à jour Alivrer dans ComCli
If Forms![frm_Reference]![Stock] = True Then
DoCmd.OpenQuery "reqStock" 'Met à jour stock article si gestion
stock
End If
'Test si ComCli doit être effacer
'Crée l'instruction SELECT pour rechercher si reste à livrer
MonSQL = "SELECT Sum(tblComCliDetail.ARecevoir) AS SommeDeARecevoir,
tblComCli.Ref_Facture "
MonSQL = MonSQL & "FROM tblComCli INNER JOIN tblComCliDetail ON
tblComCli.NFacture = tblComCliDetail.NFacture "
MonSQL = MonSQL & "GROUP BY tblComCli.Ref_Facture HAVING
tblComCli.Ref_Facture = '" & Forms![frm_Facture]![ComCli] & "';"
Set livr = MaBase.OpenRecordset(MonSQL, DB_READONLY)
livr.MoveFirst

'Si ARecevoir=0 on efface ComCli
If livr!SommeDeARecevoir = 0 Then
DoCmd.OpenQuery "reqSuprComCli"
End If

livr.Close
DoCmd.SetWarnings True
End If

Set livr = Nothing
Set MaBase = Nothing
Set Tmp = Nothing

Exit_ComCli:
Exit Sub

Err_ComCli_Click:
MsgBox Error$
Resume Exit_ComCli
End Sub

Private Sub Commande384_Click()
On Error GoTo Err_Commande384_click

Const MB_OK = 0, MB_OKANNULER = 1 ' Définit les boutons.
Const MB_OUINONANNULER = 3, MB_OUINON = 4
Const MB_ICONSTOP = 64, MB_ICONQUESTION = 32 ' Définit les icônes.
Const MB_ICONEXCLAMATION = 48, MB_ICONINFORMATION = 64
Const MB_DEFBOUTON2 = 256, IDOUI = 6, IDNON = 7 ' Autres définitions.
Titre = "Assyst by MCB"
Msg = "Voulez-vous visualiser les acomptes versés par ce client?" & Chr(10)
DéfBD = MB_OUINON + MB_ICONSTOP + MB_DEFBOUTON2 ' Décrit la boîte de
dialogue.
Réponse = MsgBox(Msg, DéfBD, Titre) ' Retourne la réponse de l'utilisateur.
If Réponse = IDOUI Then ' Evalue la réponse
DoCmd.Echo False
DoCmd.OpenForm "frm_Nb_Acompte"
End If

exit_Commande384_click:
DoCmd.Echo True
Exit Sub

Err_Commande384_click:
MsgBox Error$
Resume exit_Commande384_click

End Sub

Private Sub Bouton_Modifier_Click()
On Error GoTo Err_Bouton_Modifier_Click
'Opérations sur les contrôles
Dim varTmp As Variant
Titre = "Assyst by MCB"

If Me.ExpCompta = True Then
Msg = "Attention: Facture exportée dans la compta." & Chr(10)
Msg = Msg & "Vous ne pouvez plus la modifier !"
MsgBox Msg
Else
If Me!EstImprimer = True Then
Const MB_OK = 0, MB_OKANNULER = 1 ' Définit les boutons.
Const MB_OUINONANNULER = 3, MB_OUINON = 4
Const MB_ICONSTOP = 64, MB_ICONQUESTION = 32 ' Définit les
icônes.
Const MB_ICONEXCLAMATION = 48, MB_ICONINFORMATION = 64
Const MB_DEFBOUTON2 = 256, IDOUI = 6, IDNON = 7 ' Autres
définitions.

Msg = "Attention, facture déja imprimée. " & Chr(10)
Msg = Msg & "Voulez-vous quand-même la modifier? "
DéfBD = MB_OUINON + MB_ICONSTOP + MB_DEFBOUTON2 ' Décrit la boîte de
dialogue.
Réponse = MsgBox(Msg, DéfBD, Titre) ' Retourne la réponse de
l'utilisateur.
If Réponse = IDOUI Then ' Evalue la réponse
varTmp = VérouilleContrôles("DETAIL", False)
'Opérations sur les boutons
Me![IdClient].SetFocus
Me![Bouton_Modifier].Visible = False
Me![Bouton_Annuler].Visible = True
'Opérations sur les contrôles
Me!SRabais.Locked = True
Me!STFacture.Locked = True
Me!Montant_TVA.Locked = True
Me!TotalFacture.Locked = True
Me!Date_Cloture.Locked = True
Me!EstImprimer.Locked = True
Me!ArrondirA.Locked = True
End If
Else
varTmp = VérouilleContrôles("DETAIL", False)
'Opérations sur les boutons
Me![IdClient].SetFocus
Me![Bouton_Modifier].Visible = False
Me![Bouton_Annuler].Visible = True
'Opérations sur les contrôles
Me!SRabais.Locked = True
Me!STFacture.Locked = True
Me!Montant_TVA.Locked = True
Me!TotalFacture.Locked = True
Me!Date_Cloture.Locked = True
Me!EstImprimer.Locked = True
Me!ArrondirA.Locked = True
End If
End If
Set varTmp = Nothing

Exit_Bouton_Modifier_Click:
Exit Sub

Err_Bouton_Modifier_Click:
'MsgBox Err.Description
Resume Exit_Bouton_Modifier_Click
End Sub

Private Sub Bouton_Annuler_Click()
On Error GoTo Err_Bouton_Annuler_Click
Dim varTmp As Variant
'Opérations sur les contrôles
varTmp = VérouilleContrôles("DETAIL", True)

'Opérations sur les boutons
Me![IdClient].SetFocus
Me![Bouton_Modifier].Visible = True
Me![Bouton_Annuler].Visible = False
Set varTmp = Nothing

Exit_Bouton_Annuler_Click:
Exit Sub

Err_Bouton_Annuler_Click:
MsgBox Err.Description
Resume Exit_Bouton_Annuler_Click

End Sub

Private Sub Commande405_Click()
On Error GoTo Err_Commande405_click
'Permet mise à jour directe de mouvements de caisse et cloture facture
Dim TP

If Me![Ref_Facture] <> "" Then
Dim Cloture
Dim CountPrint As Integer
Const MB_OK = 0, MB_OKANNULER = 1 ' Définit les boutons.
Const MB_OUINONANNULER = 3, MB_OUINON = 4
Const MB_ICONSTOP = 64, MB_ICONQUESTION = 32 ' Définit les icônes.
Const MB_ICONEXCLAMATION = 48, MB_ICONINFORMATION = 64
Const MB_DEFBOUTON2 = 256, IDOUI = 6, IDNON = 7 ' Autres définitions.
Titre = "Assyst by MCB"
Msg = "Voulez-vous encaisser directement cette facture " & Chr(10)
Msg = Msg & "et mettre à jour le mouvement de caisse ? "
DéfBD = MB_OUINON + MB_ICONSTOP + MB_DEFBOUTON2 ' Décrit la boîte de
dialogue.
Réponse = MsgBox(Msg, DéfBD, Titre) ' Retourne la réponse de
l'utilisateur.
If Réponse = IDOUI Then ' Evalue la réponse
Me.Recalc
Me!Total_TVA = Me!Montant_TVA
If Me!ArrondirA = False Then
Me!Total_Facture = Me!TotalFacture
End If
Me!Choix_Echeance = 0 'Date du jours

'Recherche ID paiement comptant
TP = DLookup("IdTypepaiement", "tblTypepaiement", "[Typepaiement]
Like '*comptant'")
If Not IsNull(TP) Then
Me.TypePaiement = TP
Else
Me.TypePaiement = 6 'Paiement comptant
End If

Me!Echeance_Facture = Date
Me.Recalc
DoCmd.RunCommand acCmdSaveRecord
DoCmd.Echo False
DoCmd.Hourglass True
If Forms!frm_Reference!PrintFact = True Then
rep = "rep_facture"
Tmp = Forms!frm_Reference!NbPrinter
CountPrint = 0
Me!EstImprimer = True ' Valide controle impression
Do While CountPrint < Tmp
DoCmd.OpenReport rep, , , "[Ref_Facture] =
Forms![frm_Facture]![Ref_Facture]"
CountPrint = CountPrint + 1
Loop
DoCmd.Close A_REPORT, rep
End If
Me.Recalc
DoCmd.Hourglass True
DoCmd.RunCommand acCmdSaveRecord
'Exécute Paiement
If IsNull(Me!Date_Cloture) Then
DoCmd.OpenForm "frm_Visualisation_Facturation", , , "[NFacture]
= forms!frm_Facture!NFacture"
Forms!frm_Visualisation_Facturation!ValEncaisser =
Forms!frm_Facture!Total_Facture
DoCmd.Close acForm, "frm_Facture"
Forms!frm_Visualisation_Facturation![ChoixCompte] = 1 'Caisse
PaiementDebiteur
Forms!frm_Visualisation_Facturation![Date_Cloture] = Date
DoCmd.RunCommand acCmdSaveRecord
Msg = "Encaissement effectué." & Chr(10)
Tmp = MsgBox(Msg, 64, "Assyst by MCB")
Else
Msg = "Encaissement déja effectué." & Chr(10)
Tmp = MsgBox(Msg, 64, "Assyst by MCB")
End If
DoCmd.Close acForm, "frm_Visualisation_Facturation"
DoCmd.Echo True
DoCmd.Hourglass False
End If
End If
Set Cloture = Nothing

exit_Commande405_click:
DoCmd.Hourglass False
DoCmd.Echo True
Exit Sub

Err_Commande405_click:
'MsgBox Err.Description
Resume exit_Commande405_click
End Sub

Private Sub Commande433_Click()
On Error GoTo Err_Commande433_Click
Const MB_OK = 0, MB_OKANNULER = 1 ' Définit les boutons.
Const MB_OUINONANNULER = 3, MB_OUINON = 4
Const MB_ICONSTOP = 64, MB_ICONQUESTION = 32 ' Définit les icônes.
Const MB_ICONEXCLAMATION = 48, MB_ICONINFORMATION = 64
Const MB_DEFBOUTON2 = 256, IDOUI = 6, IDNON = 7 ' Autres définitions.
Titre = "Assyst by MCB"
Msg = "Voulez-vous modifier le nom pour cette facture ?"
DéfBD = MB_OUINON + MB_ICONSTOP + MB_DEFBOUTON2 ' Décrit la boîte de
dialogue.
Réponse = MsgBox(Msg, DéfBD, Titre) ' Retourne la réponse de l'utilisateur.
If Réponse = IDOUI Then ' Evalue la réponse
Forms![frm_Facture]![IdClient].Locked = False
Msg = "Vous pouvez le modifier maintenant."
Tmp = MsgBox(Msg, 64, "Assyst by MCB")
End If

Exit_Commande433_Click:
Exit Sub

Err_Commande433_Click:
MsgBox Err.Description
Resume Exit_Commande433_Click
End Sub


Private Sub Commande527_Click()
On Error GoTo Err_Commande527_Click
Const MB_OK = 0, MB_OKANNULER = 1 ' Définit les boutons.
Const MB_OUINONANNULER = 3, MB_OUINON = 4
Const MB_ICONSTOP = 64, MB_ICONQUESTION = 32 ' Définit les icônes.
Const MB_ICONEXCLAMATION = 48, MB_ICONINFORMATION = 64
Const MB_DEFBOUTON2 = 256, IDOUI = 6, IDNON = 7 ' Autres définitions.
Titre = "Assyst by MCB"
Msg = "Voulez-vous modifier le flag export compta ?"
DéfBD = MB_OUINON + MB_ICONSTOP + MB_DEFBOUTON2 ' Décrit la boîte de
dialogue.
Réponse = MsgBox(Msg, DéfBD, Titre) ' Retourne la réponse de l'utilisateur.
If Réponse = IDOUI Then ' Evalue la réponse
Me.ExpCompta = False
End If

Exit_Commande527_Click:
Exit Sub

Err_Commande527_Click:
MsgBox Err.Description
Resume Exit_Commande527_Click
End Sub

Private Sub Date_Facture_Exit(Cancel As Integer)
DoCmd.GoToControl "Ref_Facture"
Me![Echeance_Facture] = Me![Date_Facture] + Me![Choix_Echeance]
End Sub

Private Sub Escompte_AfterUpdate()
If IsNull(Me![Escompte]) Then Me![Escompte] = 0
End Sub


Private Sub EstImprimer_Click()
On Error GoTo Err_EstImprimer_Click

If Me!EstImprimer = 0 Then
Const MB_OK = 0, MB_OKANNULER = 1 ' Définit les boutons.
Const MB_OUINONANNULER = 3, MB_OUINON = 4
Const MB_ICONSTOP = 64, MB_ICONQUESTION = 32 ' Définit les icônes.
Const MB_ICONEXCLAMATION = 48, MB_ICONINFORMATION = 64
Const MB_DEFBOUTON2 = 256, IDOUI = 6, IDNON = 7 ' Autres définitions.
Titre = "Assyst by MCB"
Msg = "Voulez-vous supprimer l'information document imprimé ?"
DéfBD = MB_OUINON + MB_ICONSTOP + MB_DEFBOUTON2 ' Décrit la boîte de
dialogue.
Réponse = MsgBox(Msg, DéfBD, Titre) ' Retourne la réponse de
l'utilisateur.
If Réponse = IDOUI Then ' Evalue la réponse
Me!EstImprimer = False
Else
Me!EstImprimer = True
End If
End If

Exit_EstImprimer_Click:
Exit Sub

Err_EstImprimer_Click:
'MsgBox Err.Description
Resume Exit_EstImprimer_Click
End Sub

Private Sub Filtre_AfterUpdate()
Forms!frm_Facture!Sfrm_Facture_Introduction!NArticle.Requery
End Sub

Private Sub Form_Activate()
DoCmd.Maximize
End Sub

Private Sub Form_Close()
'Blocage si ouverture en modification
Dim varTmp As Variant
annuler:
'Opérations sur les contrôles
varTmp = VérouilleContrôles("DETAIL", False)
Set varTmp = Nothing

End Sub

Private Sub Form_Current()
Forms!frm_Facture.Refresh
MonName = "" 'Variable pour nom user

If IsNull([Date_Cloture]) Then
[Date_Cloture].BackColor = RGB(255, 0, 0)
Else
[Date_Cloture].BackColor = RGB(0, 255, 0)
End If

If Me!Leasing = True Then
Me!IdLeasing.Visible = True
Else
Me!IdLeasing.Visible = False
End If

End Sub

Private Sub Form_Error(DataErr As Integer, Response As Integer)
Dim Msg As String
Select Case DataErr
Case 3101
Response = acDataErrContinue
Msg = " Veuillez choisir un client en premier "
MsgBox Msg, vbExclamation
SendKeys "{ESC}", True
Response = acDataErrContinue
Case Else
Response = acDataErrContinue
End Select
End Sub

Private Sub Form_Open(Cancel As Integer)
Dim Tmp
MonName = "" 'Variable pour nom user
MonVehic = ""

'Check resolution ecran
If Resol = 0 Then
'Pas en 800x600
Forms!frm_Facture!Sfrm_Facture_Introduction.Width = 15250
Forms!frm_Facture!Sfrm_Facture_Introduction.Height = 6100
End If

If IsNull([Date_Cloture]) Then
[Date_Cloture].BackColor = RGB(255, 0, 0)
Else
[Date_Cloture].BackColor = RGB(0, 255, 0)
End If

Me!CodeTVA.DefaultValue = DLookup("[TypeTVA]", "tblTVA", "[PosDef]=True")
Me!TVA.DefaultValue = DLookup("[ValeurTVA]", "tblTVA", "[PosDef]=True")

Tmp = DLookup("[IdTypePaiement]", "tblTypePaiement", "[PosDef]=True")
If Not IsNull(Tmp) Then
Me!TypePaiement.DefaultValue = Tmp
End If

Tmp = DLookup("[IdVisa]", "tblVisa", "[PosDef]=True")
If Not IsNull(Tmp) Then
Me!Visa.DefaultValue = Tmp
End If

'Option GPAO
If Forms!frm_Reference!GPAO = True Or Forms!frm_Reference!Livraison = True
Then
Me!NCommun.Visible = True
End If

If Me!Leasing = True Then
Me!IdLeasing.Visible = True
Else
Me!IdLeasing.Visible = False
End If

If Forms!frm_Reference!CDImport = True Then
Me!ArtCD.Visible = True
Me!ArtCDTxt.Visible = True
End If

If Forms!frm_Reference!Revendeur = True Then
Me!ComCli.Visible = True
End If

Tmp = Date
Tmp = Year(Tmp)
Me!AnneeComptable.DefaultValue = Tmp
Set Tmp = Nothing

End Sub

Private Sub Frais_Port_AfterUpdate()
If IsNull(Me![Frais_Port]) Then Me![Frais_Port] = 0
End Sub

Private Sub IdClient_AfterUpdate()
'Contrôle si note de crédit en cours pour ce client
On Error GoTo Err_IdClient_Click
Dim MaBase As Database
Dim livr As Recordset
Dim MonSQL As String
Set MaBase = CurrentDb()
Me!AnneeComptable = Year(Now())
Forms!frm_Facture!Sfrm_Facture_Introduction.Form.Visible = True

If Me!TypeEtat = 5 Or Me!TypeEtat = 6 Then
Me!Rabais = 0
Else
Me!Rabais = Me!IdClient.Column(2)
End If

'Me!TypePaiement = Me!IdClient.Column(3)
Me!TypePaiement = DLookup("TypePaiement", "tblAdresse",
"[IdClient]=forms!frm_Facture!IdClient")
'Mise à jours délais paiement
Me!Choix_Echeance = Me![TypePaiement].Column(2)
Me![Echeance_Facture] = Me![Date_Facture] + Me![Choix_Echeance]

DoCmd.GoToControl "Ref_Facture"

MonSQL = "SELECT DISTINCTROW [IdClient], [Date_Cloture] FROM tblFacture "
MonSQL = MonSQL & "WHERE [IdClient] Like " & Forms![frm_Facture]![IdClient]
& " "
MonSQL = MonSQL & "AND [Date_Cloture] Is Null and [TypeEtat]=5 and
[Ref_Facture]<> '" & Forms![frm_Facture]![Ref_Facture] & "';"

Set livr = MaBase.OpenRecordset(MonSQL, DB_READONLY) 'Test si existe dans
table Factures
If livr.BOF = True Then 'Si vrai = pas de donnée
Else
Msg = "Attention Note de crédit en cours pour ce client !"
Tmp = MsgBox(Msg, 64, "Assyst by MCB")
End If
livr.Close

'Contrôle si rapport de travail en cours pour ce client
MonSQL = "SELECT DISTINCTROW [IdClient], [Date_Cloture] FROM tblTravail "
MonSQL = MonSQL & "WHERE [IdClient] Like " & Forms![frm_Facture]![IdClient]
& " "
MonSQL = MonSQL & "AND [Date_Cloture] Is Null;"

Set livr = MaBase.OpenRecordset(MonSQL, DB_READONLY) 'Test si existe dans
table travail
If livr.BOF = True Then 'Si vrai = pas de donnée
Else
Msg = "Attention rapport de travail en cours pour ce client !"
Tmp = MsgBox(Msg, 64, "Assyst by MCB")
End If
livr.Close

'Contrôle info pour ce client
MonSQL = "SELECT DISTINCTROW [Info] FROM tblAdresse "
MonSQL = MonSQL & "WHERE [IdClient] Like " & Forms![frm_Facture]![IdClient]
& ";"

Set livr = MaBase.OpenRecordset(MonSQL, DB_READONLY) 'Test si existe dans
table travail
If livr.BOF = False Then 'Si vrai = pas de donnée
If livr!Info = True Then
Msg = "Attention voir info pour ce client !"
Tmp = MsgBox(Msg, 64, "Assyst by MCB")
End If
End If
livr.Close

'Check si facture is leasing
If Me!Leasing = True Then
Me!Concerne = Me!IdClient.Column(1)
Me!TxtVotreRef.Caption = "Livré le"
Me!TxtConcerne.Caption = "Pour Client"
Me!TxtSuppl.Caption = "N° de contrat"
Else
Me!TxtVotreRef.Caption = "Votre réf."
Me!TxtConcerne.Caption = "Concerne"
Me!TxtSuppl.Caption = "Texte suppl."
End If

Set livr = Nothing
Set MaBase = Nothing

Exit_IdClient:
Exit Sub

Err_IdClient_Click:
MsgBox Error$
Resume Exit_IdClient
End Sub

Private Sub IdClient_DblClick(Cancel As Integer)
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = "frm_Introduction_Adresse"
stLinkCriteria = "[IdClient]=" & Me![IdClient] & ""
DoCmd.OpenForm stDocName, , , stLinkCriteria
End Sub

Private Sub IdClient_GotFocus()

[IdClient].Requery
'If MonName = "" Then
'Else
'Me![IdClient] = MonName
'DoCmd.GoToControl "Ref_Facture"
'End If

End Sub


Private Sub IdClient_NotInList(NewData As String, Response As Integer)
Dim ctl As Control
Dim MonForm As String

MonForm = "frm_Introduction_Adresse"
' Retourne l'objet ControlAffecté à la zone de liste modifiable.
Set ctl = Me!IdClient
' Invite l'utilisateur à confirmer s'il souhaite ajouter une nouvelle
valeur.
If MsgBox("Cette valeur ne figure pas dans la liste. Faut-il l'ajouter ?",
vbOKCancel) = vbOK Then
' Efface le texte entré par l'utilisateur de la zone de liste
Response = acDataErrContinue
ctl.Undo
' Ajoute la chaîne de l'argument NouvDonnée au contenu.
DoCmd.OpenForm MonForm, A_NORMAL, , , A_ADD
Forms(MonForm)![NomDe] = NewData

'Mets en majuscule la première lettre du NomDe.
If Not (IsNull(Forms(MonForm)![NomDe])) Then
Forms(MonForm)![NomDe] = Correct(Forms(MonForm)![NomDe])
End If
DoCmd.GoToControl "Titre"
Else
Response = acDataErrContinue
ctl.Undo
End If
Forms![frm_Facture]![Sfrm_Facture_Introduction].[Form].Visible = True
Set ctl = Nothing

End Sub

Private Sub IdLeasing_AfterUpdate()
DoCmd.GoToControl "IdClient"
End Sub

Private Sub Leasing_AfterUpdate()

If Me!Leasing = True Then
Me!IdLeasing.Visible = True
Me!Concerne = Me!IdClient.Column(1)
Me!TxtVotreRef.Caption = "Livré le"
Me!TxtConcerne.Caption = "Pour Client"
Me!TxtSuppl.Caption = "N° de contrat"
DoCmd.GoToControl "IdLeasing"
Else
Me!IdLeasing.Visible = False
Me!TxtVotreRef.Caption = "Votre réf."
Me!TxtConcerne.Caption = "Concerne"
Me!TxtSuppl.Caption = "Texte suppl."
End If

End Sub

Private Sub ModAdresse_Click()
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = "frm_Introduction_Adresse"
stLinkCriteria = "[IdClient]=" & Me![IdClient] & ""
DoCmd.OpenForm stDocName, , , stLinkCriteria
End Sub

Private Sub Modele_AfterUpdate()
On Error GoTo Err_Modele_Click
If Me!IdClient <> 0 Then
DoCmd.SetWarnings False
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
DoCmd.OpenQuery "reqModeleAjouter" 'Ajoute modèle
DoCmd.Requery "Sfrm_Facture_Introduction" 'Actualise (Shift + F9)
DoCmd.SetWarnings True
Else
MsgBox "Veuillez choisir un client en premier svp!"
DoCmd.GoToControl "IdClient"
End If

Exit_Err_Modele_Click:
DoCmd.SetWarnings True
Exit Sub

Err_Modele_Click:
MsgBox Error$
Resume Exit_Err_Modele_Click
End Sub

Private Sub NCommun_AfterUpdate()
On Error GoTo Err_ReprLivr_Click

Dim MaBase As Database
Dim livr As Recordset
Dim Tmp, Tmp2 As String
Dim MonSQL As String
Set MaBase = CurrentDb()

'Met à jour IdClient selon livraison
Forms![frm_Facture]![IdClient] = Forms![frm_Facture]![NCommun].Column(2)

'Met focus sur IdClient
DoCmd.GoToControl "Ref_Facture"

Const MB_OK = 0, MB_OKANNULER = 1
Const MB_OUINONANNULER = 3, MB_OUINON = 4
Const MB_ICONSTOP = 64, MB_ICONQUESTION = 32
Const MB_ICONEXCLAMATION = 48, MB_ICONINFORMATION = 64
Const MB_DEFBOUTON2 = 256, IDOUI = 6, IDNON = 7
Titre = "Assyst by MCB"
Msg = "Voulez-vous facturer vos livraisons" & vbCrLf
Msg = Msg & "pour ce client?"
DéfBD = MB_OUINON + MB_ICONSTOP + MB_DEFBOUTON2
Réponse = MsgBox(Msg, DéfBD, Titre)
If Réponse = IDOUI Then
Forms![frm_Facture]![Sfrm_Facture_Introduction].[Form].Visible = True
'Crée l'instruction SELECT pour rechercher Concerne dans Table
Commandes.
MonSQL = "SELECT Concerne, NCommun, NCommande, RabaisT, Frais_Port,
Texte_Fact from tblLivraison "
MonSQL = MonSQL & "WHERE tblLivraison.Facturer=No AND [NCommun] = '" &
Forms![frm_Facture]![NCommun] & "';"

Set livr = MaBase.OpenRecordset(MonSQL, DB_READONLY)
livr.MoveFirst
Forms![frm_Facture]!Concerne = livr!Concerne
Forms![frm_Facture]!NCommun = livr!NCommun
Forms![frm_Facture]!NCommande = livr!NCommande
Forms![frm_Facture]!Texte_Fact = livr!Texte_Fact
Forms![frm_Facture]!RabaisT = livr!RabaisT
Forms![frm_Facture]!Frais_Port = livr!Frais_Port
livr.Close

'Crée l'instruction SELECT pour rechercher date livraison et N°livraison
dans Table Livraison
MonSQL = "SELECT Date_Facture, Ref_Facture from tblLivraison "
MonSQL = MonSQL & "WHERE [Facturer]= No AND [NCommun]= '" &
Forms![frm_Facture]![NCommun] & "';"

Set livr = MaBase.OpenRecordset(MonSQL, DB_READONLY)

livr.MoveFirst
Do Until livr.EOF 'Commence la boucle.
Tmp = Format(livr!Date_Facture, "dd mm yy")
Tmp2 = livr!Ref_Facture
If Forms![frm_Facture]!Origine = "" Then
Forms![frm_Facture]!Origine = "livr. n°" & Tmp2 & " " & Tmp &
vbCrLf
Else
Forms![frm_Facture]!Origine = Forms![frm_Facture]!Origine &
"livr. n°" & Tmp2 & " - " & Tmp & vbCrLf
End If
livr.MoveNext
Loop
livr.Close

DoCmd.SetWarnings False
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
DoCmd.OpenQuery "reqAjoutDetailLivraisonFacture" 'Ajoute livraison
DoCmd.Requery "Sfrm_Facture_Introduction"
DoCmd.OpenQuery "reqMiseJourFacturerLivraison"
Forms![frm_Facture].Recalc

'Me!TypePaiement = Me!IdClient.Column(3)
Forms![frm_Facture]!TypePaiement = DLookup("TypePaiement", "tblAdresse",
"[IdClient]=forms!frm_Facture!IdClient")
'Mise à jours délais paiement
Forms![frm_Facture]!Choix_Echeance =
Forms![frm_Facture]![TypePaiement].Column(2)
Forms![frm_Facture]![Echeance_Facture] =
Forms![frm_Facture]![Date_Facture] + Forms![frm_Facture]![Choix_Echeance]

DoCmd.RunCommand acCmdSaveRecord
DoCmd.SetWarnings True
End If

Set MaBase = Nothing
Set livr = Nothing

Exit_ReprLivr:
Exit Sub

Err_ReprLivr_Click:
MsgBox Error$
Resume Exit_ReprLivr
End Sub

Private Sub NCommun_GotFocus()
If Not IsNull(Me!NCommun) Then Me!NCommun.Locked = True
End Sub


Private Sub NTravail_AfterUpdate()
On Error GoTo Err_NTravail_Click
'Reprend données du rapport de travail
Dim MaBase As Database
Dim livr As Recordset
Dim MonSQL, Tmp, Tmp2 As String
Set MaBase = CurrentDb()

Const MB_OK = 0, MB_OKANNULER = 1 ' Définit les boutons.
Const MB_OUINONANNULER = 3, MB_OUINON = 4
Const MB_ICONSTOP = 64, MB_ICONQUESTION = 32 ' Définit les icônes.
Const MB_ICONEXCLAMATION = 48, MB_ICONINFORMATION = 64
Const MB_DEFBOUTON2 = 256, IDOUI = 6, IDNON = 7 ' Autres définitions.
Titre = "Assyst by MCB"
Msg = "Voulez-vous ajouter un rapport de travail à la facture?" & Chr(10)
DéfBD = MB_OUINON + MB_ICONSTOP + MB_DEFBOUTON2 ' Décrit la boîte de
dialogue.
Réponse = MsgBox(Msg, DéfBD, Titre) ' Retourne la réponse de l'utilisateur.
If Réponse = IDOUI Then ' Evalue la réponse
'Met à jour IdClient selon devis
Dim Temp
Temp = Me![NTravail].Column(4)
Me![IdClient] = Temp
Forms![frm_Facture]![Sfrm_Facture_Introduction].[Form].Visible = True

'Met focus sur IdClient
DoCmd.GoToControl "IdClient"
DoCmd.GoToControl "Ref_Facture"
Forms![frm_Facture]![Sfrm_Facture_Introduction].[Form].Visible = True
'Crée l'instruction SELECT pour rechercher contrôle Concerne et RabaisT
du rapport de travail
MonSQL = "SELECT DISTINCTROW [Ref_Facture], [Date_Facture], [Concerne],
[RabaisT], [Taux_TVA], [CodeTVA], [Frais_Port], [TypePaiement] FROM
tblTravail "
MonSQL = MonSQL & "WHERE [Ref_Facture] = '" &
Forms![frm_Facture]![NTravail] & "';"
Set livr = MaBase.OpenRecordset(MonSQL, DB_READONLY)
livr.MoveFirst
Me!Concerne = livr!Concerne
Me!Taux_TVA = livr!Taux_TVA
Me!RabaisT = livr!RabaisT
Me!CodeTVA = livr!CodeTVA
Me!Frais_Port = livr!Frais_Port
Me!TypePaiement = livr!TypePaiement

'Mise à jours délais paiement
Me!Choix_Echeance = Me![TypePaiement].Column(2)
Me![Echeance_Facture] = Me![Date_Facture] + Me![Choix_Echeance]

Tmp = Format(livr!Date_Facture, "dd mm yy")
Tmp2 = livr!Ref_Facture
If Me!Origine = "" Then
Me!Origine = "Rap. trav. n°" & Tmp2 & " du " & Tmp & vbCrLf
Else
Me!Origine = Me!Origine & "Rap. trav. n°" & Tmp2 & " du " & Tmp &
vbCrLf
End If

livr.Close
DoCmd.SetWarnings False
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
DoCmd.OpenQuery "reqTravailAjouter" 'Ajoute travail regroupé
DoCmd.OpenQuery "reqTravailAjouterNull" 'Ajoute travail sans
regroupement
DoCmd.Requery "Sfrm_Facture_Introduction" 'Actualise (Shift + F9)
DoCmd.OpenQuery "reqMiseJourTravail" 'Mets à jour Facturer dans table
Travail
DoCmd.SetWarnings True
End If

Set livr = Nothing
Set MaBase = Nothing

Exit_NTravail:
Exit Sub

Err_NTravail_Click:

MsgBox Error$
Resume Exit_NTravail
End Sub

Private Sub NVoiturelist_GotFocus()
[NVoiturelist].Requery
If MonVehic = "" Then
Else
Me![NVoiturelist] = MonVehic
DoCmd.GoToControl "Concerne"
End If
End Sub

Private Sub NVoiturelist_NotInList(NewData As String, Response As Integer)
Dim ctl As Control
Dim MonForm As String
Dim Tmp As Integer

Tmp = Me!IdClient
MonForm = "frm_Introduction_Vehicule"

' Retourne l'objet ControlAffecté à la zone de liste modifiable.
Set ctl = Me!NVoiturelist
' Invite l'utilisateur à confirmer s'il souhaite ajouter une nouvelle
valeur.
If MsgBox("Cette valeur ne figure pas dans la liste. Faut-il l'ajouter ?",
vbOKCancel) = vbOK Then
' Efface le texte entré par l'utilisateur de la zone de liste
Response = acDataErrContinue
ctl.Undo
' Ajoute la chaîne de l'argument NouvDonnée au contenu.
DoCmd.OpenForm MonForm, A_NORMAL, , , A_ADD
Forms(MonForm)![IdClient] = Tmp
Forms(MonForm)![NPlaque] = NewData
DoCmd.GoToControl "NMarque"
Else
Response = acDataErrContinue
ctl.Undo
End If
Set ctl = Nothing

End Sub

Private Sub Prorata_AfterUpdate()
If IsNull(Me![Prorata]) Then Me![Prorata] = 0
End Sub

Private Sub Rabais_AfterUpdate()
If IsNull(Me![Rabais]) Then Me![Rabais] = 0
End Sub

Private Sub Ref_Facture_Change()

If Me!Rabais = 0 Then 'Test rabais du client
Me!Rabais = Me!IdClient.Column(2)
End If
'If Me!Cocher401 = True Then Me!Rabais = 0 'Test si acompte
Me![TypePaiement] = Me![IdClient].Column(3)

End Sub

Private Sub Ref_Facture_GotFocus()
'Permet de faire un champ compteur pour Ref_facture depuis le champ NFacture
On Error GoTo Err_Ref_facture_Click
Dim MaBase, Db As Database
Dim livr, livr1 As Recordset
Dim Temp
Dim MonSQL As String
Set MaBase = CurrentDb()

If Forms!frm_Facture!IdClient = 0 Then
MsgBox "Sélectionnez un client en premier svp !"
Else
'Champ compteur pour réf facture
If IsNull(Forms!frm_Facture![Ref_Facture]) Or
Forms!frm_Facture![Ref_Facture] = "" Then
'For seek
'Set Db = DBEngine.OpenDatabase(Reseau & "TMCB.mdb")
Set Db = DBEngine.Workspaces(0).OpenDatabase(Reseau & "TMCB.mdb")
Set livr1 = Db.OpenRecordset("tblFacture")
livr1.Index = "Ref_Facture"
MonSQL = "SELECT TOP 1 NFacture, Ref_Facture FROM tblFacture ORDER
BY NFacture DESC;"
Set livr = MaBase.OpenRecordset(MonSQL, DB_READONLY)
If livr.BOF = False Then
Temp = Nz(livr!Ref_Facture)
Temp = Val(Temp)
End If
livr.Close
'Recherche si éxiste
Do
livr1.Seek "=", Temp + 1
If livr1.NoMatch Then
'Pas trouvé
Exit Do
Else
'Trouvé
End If
Temp = Temp + 1
Loop
livr1.Close

If Temp = 0 Then
If Forms!frm_Facture!NFacture = 1 Then
Temp = 1
Else
Temp = Forms!frm_Facture!NFacture + 1
End If
Else
Temp = Temp + 1
End If
Forms!frm_Facture!Ref_Facture = Temp
Set Temp = Nothing
Set livr = Nothing
Set livr1 = Nothing
Set MaBase = Nothing
Set Db = Nothing
End If
End If
Forms!frm_Facture.Recalc
TestLimite

Exit_Ref_facture_Click:
DoCmd.Echo True
Exit Sub

Err_Ref_facture_Click:
Msg = "N° de référence du document déja utilisé!" & vbCrLf
Msg = Msg & "Veuillez changer de n° svp."
Titre = "Assyst by MCB"
MsgBox Msg, 48, Titre
Resume Exit_Ref_facture_Click

End Sub

Private Sub ReprDevis_AfterUpdate()
On Error GoTo Err_ReprDevis_Click

'Reprend données du devis
Dim MaBase As Database
Dim livr As Recordset
Dim Temp
Dim MonSQL, Tmp, Tmp2 As String
Set MaBase = CurrentDb()

Const MB_OK = 0, MB_OKANNULER = 1 ' Définit les boutons.
Const MB_OUINONANNULER = 3, MB_OUINON = 4
Const MB_ICONSTOP = 64, MB_ICONQUESTION = 32 ' Définit les icônes.
Const MB_ICONEXCLAMATION = 48, MB_ICONINFORMATION = 64
Const MB_DEFBOUTON2 = 256, IDOUI = 6, IDNON = 7 ' Autres définitions.
Titre = "Assyst by MCB"
Msg = "Voulez-vous ajouter un devis à la facture?" & Chr(10)
DéfBD = MB_OUINON + MB_ICONSTOP + MB_DEFBOUTON2 ' Décrit la boîte de
dialogue.
Réponse = MsgBox(Msg, DéfBD, Titre) ' Retourne la réponse de l'utilisateur.
If Réponse = IDOUI Then ' Evalue la réponse
'Met à jour IdClient selon devis
Temp = Me![ReprDevis].Column(4)
Me![IdClient] = Temp
Forms![frm_Facture]![Sfrm_Facture_Introduction].[Form].Visible = True

'Met focus sur IdClient
DoCmd.GoToControl "IdClient"
DoCmd.GoToControl "Ref_Facture"
Forms![frm_Facture]![Sfrm_Facture_Introduction].[Form].Visible = True
'Crée l'instruction SELECT pour rechercher contrôle Concerne et RabaisT
du Devis
MonSQL = "SELECT DISTINCTROW [Ref_Facture], [Date_Facture], [Concerne],
[RabaisT], [Escompte], [Prorata], [Taux_TVA], [CodeTVA], [Frais_Port],
[Texte_Fact], [TypePaiement] FROM tblNDevis "
MonSQL = MonSQL & "WHERE [Ref_Facture] = '" &
Forms![frm_Facture]![ReprDevis] & "';"
Set livr = MaBase.OpenRecordset(MonSQL, DB_READONLY)
livr.MoveFirst
Me!Concerne = livr!Concerne
Me!Taux_TVA = livr!Taux_TVA
Me!RabaisT = livr!RabaisT
Me!Escompte = livr!Escompte
Me!Prorata = livr!Prorata
Me!CodeTVA = livr!CodeTVA
Me!Frais_Port = livr!Frais_Port
Me!TypePaiement = livr!TypePaiement
Me!Texte_Fact = livr!Texte_Fact

'Mise à jours délais paiement
Me!Choix_Echeance = Me![TypePaiement].Column(2)
Me![Echeance_Facture] = Me![Date_Facture] + Me![Choix_Echeance]

Tmp = Format(livr!Date_Facture, "dd mm yy")
Tmp2 = livr!Ref_Facture
If Me!Origine = "" Then
Me!Origine = "Devis n°" & Tmp2 & " du " & Tmp & vbCrLf
Else
Me!Origine = Me!Origine & "Devis n°" & Tmp2 & " du " & Tmp & vbCrLf
End If

livr.Close
DoCmd.SetWarnings False
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
DoCmd.OpenQuery "reqDevisAjouter" 'Ajoute devis
DoCmd.Requery "Sfrm_Facture_Introduction" 'Actualise (Shift + F9)
DoCmd.OpenQuery "reqMiseJourDevis" 'Mets à jour repris devis
If Forms![frm_Reference]![Stock] = True Then
DoCmd.OpenQuery "reqStock" 'Met à jour stock article si gestion
stock
End If
DoCmd.SetWarnings True
End If

Set livr = Nothing
Set MaBase = Nothing
Set Tmp = Nothing

Exit_ReprDevis:
Exit Sub

Err_ReprDevis_Click:
MsgBox Error$
Resume Exit_ReprDevis
End Sub

Private Sub SAcompte_AfterUpdate()
If IsNull(Me![Acompte]) Then Me![Acompte] = 0
End Sub

Private Sub Total_Facture_AfterUpdate()
'Remet zero si valeur effacée
If IsNull(Me![Total_Facture]) Then
Me![Total_Facture] = 0
Else
End If

End Sub

Private Sub TVA_AfterUpdate()
If IsNull(Me![Taux_TVA]) Then Me![Taux_TVA] = 0
End Sub

Private Sub SupprEnr_Click()
On Error GoTo Err_SupprEnr_Click

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70
Me.Recalc

Exit_SupprEnr_Click:
Exit Sub

Err_SupprEnr_Click:
If InStr(Err.Description, "L'action DoMenuItem a été annulée.") Then
ElseIf InStr(Err.Description, "Impossible de supprimer ou de modifier un
enregistrement") Then
MsgBox "Vous ne pouvez pas modifier ou supprimer cet enregistrement
car il a des salaires pour cette année", 48
Else
MsgBox Err.Description
Resume Exit_SupprEnr_Click
End If

End Sub

Private Sub RechercheEn_Click()
On Error GoTo Err_RechercheEn_Click

Screen.PreviousControl.SetFocus
DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70

Exit_RechercheEn_Click:
Exit Sub

Err_RechercheEn_Click:
MsgBox Err.Description
Resume Exit_RechercheEn_Click

End Sub

Private Sub RechercheSui_Click()
On Error GoTo Err_RechercheSui_Click

Screen.PreviousControl.SetFocus
DoCmd.FindNext

Exit_RechercheSui_Click:
Exit Sub

Err_RechercheSui_Click:
MsgBox Err.Description
Resume Exit_RechercheSui_Click

End Sub

Private Sub AjoutEnr_Click()
On Error GoTo Err_AjoutEnr_Click
DoCmd.Echo False
Dim Tmp As Integer
Tmp = Me!TypeEtat
Grp = 0 'Variable groupe
MonName = "" 'Variable pour nom user
Me.Recalc

Me!Total_TVA = Me!Montant_TVA
'Test si est arrondi
If [ArrondirA] = False Then
Me!Total_Facture = Me!TotalFacture
End If
Me.Recalc

DoCmd.RunCommand acCmdSaveRecord

DoCmd.GoToRecord , , acNewRec
Me!TypeEtat = Tmp

If IsNull([Date_Cloture]) Then
Date_Cloture.BackColor = RGB(255, 0, 0)
Else
Date_Cloture.BackColor = RGB(0, 255, 0)
End If

Exit_AjoutEnr_Click:
DoCmd.Echo True
Exit Sub

Err_AjoutEnr_Click:
'MsgBox Err.Description
Resume Exit_AjoutEnr_Click

End Sub

Private Sub EnrePre_Click()
On Error GoTo Err_EnrePre_Click

Dim varTmp As Variant

DoCmd.GoToRecord , , acPrevious
MonName = "" 'Variable pour nom user
If IsNull([Date_Cloture]) Then
[Date_Cloture].BackColor = RGB(255, 0, 0)
Else
[Date_Cloture].BackColor = RGB(0, 255, 0)
End If

'Opérations sur les contrôles
varTmp = VérouilleContrôles("DETAIL", True)

'Opérations sur les boutons
Me![IdClient].SetFocus
Me![Bouton_Modifier].Visible = True
Me![Bouton_Annuler].Visible = False
Set varTmp = Nothing

Exit_EnrePre_Click:
Exit Sub

Err_EnrePre_Click:
MsgBox Err.Description
Resume Exit_EnrePre_Click

End Sub

Private Sub EnreSui_Click()
On Error GoTo Err_EnreSui_Click

Dim varTmp As Variant

DoCmd.GoToRecord , , acNext
MonName = "" 'Variable pour nom user
If IsNull([Date_Cloture]) Then
[Date_Cloture].BackColor = RGB(255, 0, 0)
Else
[Date_Cloture].BackColor = RGB(0, 255, 0)
End If

'Opérations sur les contrôles
varTmp = VérouilleContrôles("DETAIL", True)

'Opérations sur les boutons
Me![IdClient].SetFocus
Me![Bouton_Modifier].Visible = True
Me![Bouton_Annuler].Visible = False
Set varTmp = Nothing

Exit_EnreSui_Click:
Exit Sub

Err_EnreSui_Click:
MsgBox Err.Description
Resume Exit_EnreSui_Click

End Sub

Private Sub Caisse_Click()
On Error GoTo Err_Caisse_Click

DoCmd.Echo False
DoCmd.OpenForm "frm_Visualisation_Facturation", , , "[NFacture] =
forms!frm_Facture!NFacture"
Me.Recalc

Exit_Caisse_Click:
DoCmd.Echo True
Exit Sub

Err_Caisse_Click:
MsgBox Err.Description
Resume Exit_Caisse_Click

End Sub

Private Sub TypePaiement_AfterUpdate()
On Error GoTo Err_TypePaiement_Click
If Me!TypePaiement = 6 Then 'Paiement comptant
Me!Choix_Echeance = 0 'Date du jours
Me!Echeance_Facture = Date
End If

'Mise à jours délais paiement
Me!Choix_Echeance = Me![TypePaiement].Column(2)
Me![Echeance_Facture] = Me![Date_Facture] + Me![Choix_Echeance]

Exit_TypePaiement_Click:
Exit Sub

Err_TypePaiement_Click:
Resume Exit_TypePaiement_Click
End Sub

Private Sub TypePaiement_DblClick(Cancel As Integer)
DoCmd.Echo False
DoCmd.OpenForm "frm_Introduction_Multi", , , , , , "reqIntroTypePaiement"
DoCmd.ApplyFilter , "[IdTypePaiement] = Forms![frm_Facture]!TypePaiement"
DoCmd.Restore
DoCmd.Echo True
End Sub
Private Sub Commande504_Click()
On Error GoTo Err_Commande504_Click

DoCmd.Echo False
Dim Tmp, Txt
Dim Titre As String
Dim MaBase As Database
Dim livr As Recordset
Dim livr2 As Recordset
Dim MonSQL As String
Set MaBase = CurrentDb()

Titre = "Assyst by MCB"

Const MB_OK = 0, MB_OKANNULER = 1
Const MB_OUINONANNULER = 3, MB_OUINON = 4
Const MB_ICONSTOP = 64, MB_ICONQUESTION = 32
Const MB_ICONEXCLAMATION = 48, MB_ICONINFORMATION = 64
Const MB_DEFBOUTON2 = 256, IDOUI = 6, IDNON = 7

Msg = "Voulez-vous créer un acompte pour cette facture?" & vbCrLf
DéfBD = MB_OUINON + MB_ICONSTOP + MB_DEFBOUTON2
Réponse = MsgBox(Msg, DéfBD, Titre)
If Réponse = IDOUI Then ' Evalue la réponse
'Reprend ancien n°de facture
MonSQL = "SELECT TOP 1 NFacture, Ref_facture FROM tblFacture ORDER
BY NFacture DESC; "

Set livr = MaBase.OpenRecordset(MonSQL, DB_READONLY)
If livr.BOF = True Then 'Si vrai = pas de donnée
Txt = 1
Else
livr.MoveLast
Txt = livr![Ref_Facture]
livr.Close
Txt = Txt + 1
End If

Msg = "N° de référence de l'acompte" & vbCrLf
DéfValeur = Txt
Me!Transfer = InputBox(Msg, Titre, DéfValeur)

'Rechercher si n° de facture existe déja
MonSQL = "SELECT DISTINCTROW [Ref_Facture] FROM tblFacture "
MonSQL = MonSQL & "WHERE [Ref_Facture] = '" &
Forms![frm_Facture]![Transfer] & "';"

Set livr = MaBase.OpenRecordset(MonSQL, DB_READONLY)
If livr.BOF = True Then
'Ok n° facture n'existe pas
DoCmd.SetWarnings False
Msg = "Introduire le montant de l'acompte a encaisser svp!" &
vbCrLf
Me!SAcompte = InputBox(Msg, Titre)
DoCmd.OpenQuery "reqAjoutAcompte" 'Ajoute acompte

'Rechercher Nfacture
MonSQL = "SELECT DISTINCTROW [NFacture] FROM tblFacture "
MonSQL = MonSQL & "WHERE [Ref_Facture] = '" &
Forms![frm_Facture]![Transfer] & "';"

Set livr2 = MaBase.OpenRecordset(MonSQL, DB_READONLY)
livr2.MoveFirst
Me!Transfer = livr2!NFacture
DoCmd.OpenQuery "reqAjoutDetailAcompte" 'Ajoute détail acompte
DoCmd.SetWarnings True
livr2.Close

'Encaissement acompte
DoCmd.OpenForm "frm_Visualisation_Facturation", , , "[NFacture]
= forms!frm_Facture!Transfer"
Forms!frm_Visualisation_Facturation!ValEncaisser =
Forms!frm_Facture!SAcompte
Forms!frm_Visualisation_Facturation![ChoixCompte] = 1 'Caisse
PaiementDebiteur
Forms!frm_Visualisation_Facturation![Date_Cloture] = Date
DoCmd.RunCommand acCmdSaveRecord
DoCmd.Close acForm, "frm_Visualisation_Facturation"
Else
'N° de facture éxiste déja
Msg = "N°de référence déja existant, veuillez utiliser un autre
n° svp!"
Tmp = MsgBox(Msg, 64, Titre)
End If
livr.Close
Msg = "Acompte encaissé!"
Tmp = MsgBox(Msg, 64, Titre)
End If

Set Tmp = Nothing
Set Txt = Nothing
Set MaBase = Nothing
Set livr = Nothing
Set livr2 = Nothing

Exit_Commande504_Click:
DoCmd.Echo True
Exit Sub

Err_Commande504_Click:
MsgBox Err.Description
Resume Exit_Commande504_Click

End Sub




<Anor> a écrit dans le message de news:
OPRx8n$
Bonjour

tu n'avais pas dit jusqu'à présent (me souviens-je) que le pb survenait
"après modif dans le CODE du formulaire"

je pensais que c'était en fonctionnement NORMAL sous access97

Une erreur de compilation est liée à un problème de références.
Donc tu si tu utilises DAO, poste le code employé, tu libères peut-être
mal les déclarations préalabl
Avatar
Salut

Bon je suis encore perdu :
des fois ça ne compile pas
des fois ça compile
des fois ça plante au démarrage
des fois ça plante après modif
des fois ça plante au bout d'un certain temps sans modif

Bon tout ce que j'ai trouvé anormal dans ton code,
c'est les déclarations Variant (type non précisé) alors que tu pourrais mieux orienter vba en déclarant string ou un objet précis

D'autre part, tes CONST au milieu du code dans des conditions if...then , ce ne sont plus des constantes mais des variables.
Je ne pense pas que vba aime beaucoup ça.

Une constante, perso, je la déclare en dehors de toute routine ou fonction
Même une variable si besoin de la réutiliser

Maintenant, je te suggère de tester sur un autre poste ayant access97 pour savoir si c'est réellement la base qui est fragile ou
l'install qui est défectueuse


a+
--
Arnaud
-----------------------------------------
Vous êtes novice ? :
http://www.mpfa.info
-----------------------------------------




"Tony Bouquet" a écrit dans le message de news:
Hello
Base modifiée en local, pas d'autre utilisateurs (Ouverture en exclusif)
Msg d'erreur, "MSAccess a provoqué une erreur et doit être fermé..." module concerné VBA332.dll.
Encore mci pour votre aide et bon weekend
Ciao Tony

Code dans ce formulaire:


Avatar
Tony Bouquet
Hello Arnaud.
mci pour ces infos, je vais modifier mon code.
J'ai déja tester sur une autre machine mais même problème....
Bonne journée
Bye Tony

<Anor> wrote in message news:
Salut

Bon je suis encore perdu :
des fois ça ne compile pas
des fois ça compile
des fois ça plante au démarrage
des fois ça plante après modif
des fois ça plante au bout d'un certain temps sans modif

Bon tout ce que j'ai trouvé anormal dans ton code,
c'est les déclarations Variant (type non précisé) alors que tu pourrais
mieux orienter vba en déclarant string ou un objet précis


D'autre part, tes CONST au milieu du code dans des conditions if...then ,
ce ne sont plus des constantes mais des variables.

Je ne pense pas que vba aime beaucoup ça.

Une constante, perso, je la déclare en dehors de toute routine ou fonction
Même une variable si besoin de la réutiliser

Maintenant, je te suggère de tester sur un autre poste ayant access97 pour
savoir si c'est réellement la base qui est fragile ou

l'install qui est défectueuse


a+
--
Arnaud
-----------------------------------------
Vous êtes novice ? :
http://www.mpfa.info
-----------------------------------------




"Tony Bouquet" a écrit dans le message de news:


Hello
Base modifiée en local, pas d'autre utilisateurs (Ouverture en exclusif)
Msg d'erreur, "MSAccess a provoqué une erreur et doit être fermé..."
module concerné VBA332.dll.


Encore mci pour votre aide et bon weekend
Ciao Tony

Code dans ce formulaire: