Gestion Commerciale du nom de "SAGE" ...
DocteurClick
Messages postés
3
Date d'inscription
mercredi 16 avril 2003
Statut
Membre
Dernière intervention
16 mai 2003
-
29 avril 2003 à 15:48
vbpedro Messages postés 1 Date d'inscription jeudi 18 novembre 2004 Statut Membre Dernière intervention 19 novembre 2004 - 19 nov. 2004 à 11:35
vbpedro Messages postés 1 Date d'inscription jeudi 18 novembre 2004 Statut Membre Dernière intervention 19 novembre 2004 - 19 nov. 2004 à 11:35
A voir également:
- Sage 1000 gestion commerciale
- 1000 secondes en minutes ✓ - Forum PHP
- Gestion des demandes d'intervention - Forum PHP
- Revendeur sage paie - Forum Delphi / Pascal
- Gestion association joomla - Forum PHP
- Tableau gestion des clés ✓ - Forum VB.NET
3 réponses
cs_droide
Messages postés
4
Date d'inscription
vendredi 17 mai 2002
Statut
Membre
Dernière intervention
14 mai 2003
14 mai 2003 à 14:19
14 mai 2003 à 14:19
Hello!
Je ne connais pas bien Sage, mais je peux toujours te donner ce que j'ai.
Par contre, comment fais-tu pour te déconnecter de Sage à partir de VB ????
En me déconnectant, j'ai le message suivant : "Le système attend le verrouillage d'un objet."
Voici le code pour mofifier ou ajouter des Tiers (par exemple)
Code à mettre dans un module:
Public iClassManager As Ligne1000.coClassManager
Public iL1000MasterContext As New Ligne1000.L1000MasterContext
Public iMasterConnectProperties As New Ligne1000.MasterConnectProperties
Public iApplicationConnectProperties As New Ligne1000.ApplicationConnectProperties
Public Function L1000TiersGerer(Methode As Byte, _
RoleTiersReassureur As Boolean, _
RoleTiersReassureurLibelle As String, _
RoleTiersCourtier As Boolean, _
RoleTiersCourtierLibelle As String, _
RoleTiersCedant As Boolean, _
RoleTiersCoassureur As Boolean, _
TiersCode As String, _
TiersLibelle As String, _
SiteAdresse As String, _
SiteAdresseComplement As String, _
SiteCP As String, _
SiteVille As String, _
SiteCodePays As String, _
Optional MsgErreur As Boolean = False) As Variant
'------------------------------------------------------------------------------
Const METHODE_AJOUTER = 1
Const METHODE_MODIFIER = 2
Const METHODE_SUPPRIMER = 3
Const ROLE_TIERS_COURTIER = 1
Const ROLE_TIERS_REASSUREUR = 2
Const ROLE_TIERS_CEDANT = 3
Const ROLE_TIERS_COASSUREUR = 4
Dim vTTiers As Variant
Dim vTSite As Variant
Dim vTAdresse As Variant
Dim vTRoleTiers As Variant
Dim vTZReassureur As Variant
Dim vTZCourtier As Variant
Dim args(1) As Variant
Dim vT1000 As Variant
Dim L1000FindObject_RC As Variant
Dim crArgsValide As Byte
Dim Ligne As Integer
On Error GoTo Erreur
L1000TiersGerer = True
iClassManager.BeginTran
Select Case Methode
Case METHODE_AJOUTER
Set vTTiers = iClassManager.CreateObject("TTiers")
Set vTSite = iClassManager.CreateObject("TSite")
vTSite.Caption = "SITE"
vTSite.code = "SITE"
vTSite.oidTiers = vTTiers.instanceoid
'ou vTTiers.sitesListe.AddRef vTSite
Set vTAdresse = iClassManager.CreateObject("TAdresse")
vTAdresse.NomRueVoie = Trim(SiteAdresse)
vTAdresse.ComplementAdresse = Trim(SiteAdresseComplement)
vTAdresse.CodePostal = Trim(SiteCP)
vTAdresse.Ville = Trim(SiteVille)
vTSite.oidAdresse = vTAdresse.instanceoid
args(0) = Trim(SiteCodePays)
Ligne = 2
Set vT1000 = iClassManager.FindObject("TPays", "codeISO=%1", "codeISO", True, args)
vTAdresse.oidPays = vT1000.instanceoid
vTTiers.oidPays = vT1000.instanceoid
Set vTZReassureur = iClassManager.CreateObject("TZReassureur")
vTZReassureur.Caption = Right(Trim(TiersCode), 5)
vTZReassureur.libelle = Trim(TiersCode)
vTTiers.oidreassureur = vTZReassureur.instanceoid
Set vTZCourtier = iClassManager.CreateObject("TZCourtier")
vTZCourtier.Caption = Left(Trim(TiersCode), 5)
vTZCourtier.libelle = Trim(TiersCode)
vTTiers.oidcourtier = vTZCourtier.instanceoid
vTTiers.Caption = Trim(TiersLibelle)
vTTiers.code = Trim(TiersCode)
args(0) = "CHQ1"
Set vT1000 = iClassManager.FindObject("TEcheancement", "code=%1", "Caption", True, args)
vTTiers.oidecheancementDecaissement = vT1000.instanceoid
args(0) = "CHQ1"
Set vT1000 = iClassManager.FindObject("TEcheancement", "code=%1", "caption", True, args)
vTTiers.oidecheancementEncaissement = vT1000.instanceoid
args(0) = "CHQ"
Set vT1000 = iClassManager.FindObject("TModeReglement", "code=%1", "caption", True, args)
vTTiers.oidmodeReglementDecaissement = vT1000.instanceoid
args(0) = "CHQ"
Set vT1000 = iClassManager.FindObject("TModeReglement", "code=%1", "caption", True, args)
vTTiers.oidmodeReglementEncaissement = vT1000.instanceoid
If RoleTiersReassureur Then
Set vTRoleTiers = iClassManager.CreateObject("TFournisseur")
vTRoleTiers.oidTiers = vTTiers.instanceoid
'ou vTTiers.RoleTiersListe.AddRef vTRoleTiers
vTRoleTiers.oidfournisseurAPayer = vTRoleTiers.instanceoid
' vTRoleTiers.oidsiteprivilegie = vTSite.instanceoid
End If
If RoleTiersCourtier Then
Set vTRoleTiers = iClassManager.CreateObject("TClient")
vTRoleTiers.oidTiers = vTTiers.instanceoid
'ou vTTiers.RoleTiersListe.AddRef vTRoleTiers
vTRoleTiers.oidClientPayeur = vTRoleTiers.instanceoid
' vTRoleTiers.oidsitePriviligie = vTSite.instanceoid
End If
If RoleTiersCedant Then
Set vTRoleTiers = iClassManager.CreateObject("TSalarie")
vTRoleTiers.oidTiers = vTTiers.instanceoid
'ou vTTiers.RoleTiersListe.AddRef vTRoleTiers
' vTRoleTiers.oidsitePriviligie = vTSite.instanceoid
End If
If RoleTiersCoassureur Then
Set vTRoleTiers = iClassManager.CreateObject("TTiersDivers")
vTRoleTiers.oidTiers = vTTiers.instanceoid
'ou vTTiers.RoleTiersListe.AddRef vTRoleTiers
' vTRoleTiers.oidsitePriviligie = vTSite.instanceoid
End If
Case METHODE_MODIFIER, METHODE_SUPPRIMER
args(0) = Trim(TiersCode)
Ligne = 1
Set vTTiers = iClassManager.FindObject("TTiers", "code=%1", "", True, args)
Ligne = 0
If Methode = METHODE_MODIFIER Then
' crArgsValide = ArgsValide(Methode)
' If Not crArgsValide Then
' L1000TiersGerer = crArgsValide
' Exit Function
' End If
If TiersLibelle <> "" Then
vTTiers.Caption = Trim(TiersLibelle)
End If
args(0) = Trim(vTTiers.oid)
' args(1) = "SITE"
Set vTSite = iClassManager.FindObject("TSite", "oidTiers=%1", "oidTiers", True, args)
args(0) = Trim(vTSite.oidAdresse)
Set vTAdresse = iClassManager.FindObject("TAdresse", "oid=%1", "oid", True, args)
If SiteAdresse <> "" Then
vTAdresse.NomRueVoie = Trim(SiteAdresse)
End If
If SiteAdresseComplement <> "" Then
vTAdresse.ComplementAdresse = Trim(SiteAdresseComplement)
End If
If SiteCP <> "" Then
vTAdresse.CodePostal = Trim(SiteCP)
End If
If SiteVille <> "" Then
vTAdresse.Ville = Trim(SiteVille)
End If
If SiteCodePays <> "" Then
args(0) = Trim(SiteCodePays)
Ligne = 2
Set vT1000 = iClassManager.FindObject("TPays", "codeOSCE=%1", "", True, args)
vTAdresse.oidPays = vT1000.instanceoid
vTTiers.oidPays = vT1000.instanceoid
End If
Else
vTTiers.Delete = True
End If
End Select
On Error GoTo 0
On Error Resume Next
iClassManager.Commit
If Err.Number <> 0 Then
L1000TiersGerer = Err.Number
iClassManager.RollBack
If MsgErreur Then
MsgBox Err.Number & " : " & Err.Description & " => iClassManager.RollBack", vbCritical
End If
Else
If MsgErreur Then
Select Case Methode
Case METHODE_AJOUTER
MsgBox "'TTiers " & TiersCode & "' créé ... => iClassManager.Commit", vbInformation
Case METHODE_MODIFIER
MsgBox "'TTiers " & TiersCode & "' modifié ... => iClassManager.Commit", vbInformation
Case METHODE_SUPPRIMER
MsgBox "'TTiers " & TiersCode & "' supprimé ... => iClassManager.Commit", vbInformation
End Select
End If
L1000TiersGerer = True
End If
Exit Function
Erreur:
'------
Select Case Ligne
Case 1
L1000TiersGerer = 521
iClassManager.RollBack
Exit Function
Case 2
L1000TiersGerer = 522
iClassManager.RollBack
Exit Function
End Select
L1000TiersGerer = Err.Number
If MsgErreur Then
MsgBox Err.Number & " : " & Err.Description, vbCritical
End If
End Function
Droide
Je ne connais pas bien Sage, mais je peux toujours te donner ce que j'ai.
Par contre, comment fais-tu pour te déconnecter de Sage à partir de VB ????
En me déconnectant, j'ai le message suivant : "Le système attend le verrouillage d'un objet."
Voici le code pour mofifier ou ajouter des Tiers (par exemple)
Code à mettre dans un module:
Public iClassManager As Ligne1000.coClassManager
Public iL1000MasterContext As New Ligne1000.L1000MasterContext
Public iMasterConnectProperties As New Ligne1000.MasterConnectProperties
Public iApplicationConnectProperties As New Ligne1000.ApplicationConnectProperties
Public Function L1000TiersGerer(Methode As Byte, _
RoleTiersReassureur As Boolean, _
RoleTiersReassureurLibelle As String, _
RoleTiersCourtier As Boolean, _
RoleTiersCourtierLibelle As String, _
RoleTiersCedant As Boolean, _
RoleTiersCoassureur As Boolean, _
TiersCode As String, _
TiersLibelle As String, _
SiteAdresse As String, _
SiteAdresseComplement As String, _
SiteCP As String, _
SiteVille As String, _
SiteCodePays As String, _
Optional MsgErreur As Boolean = False) As Variant
'------------------------------------------------------------------------------
Const METHODE_AJOUTER = 1
Const METHODE_MODIFIER = 2
Const METHODE_SUPPRIMER = 3
Const ROLE_TIERS_COURTIER = 1
Const ROLE_TIERS_REASSUREUR = 2
Const ROLE_TIERS_CEDANT = 3
Const ROLE_TIERS_COASSUREUR = 4
Dim vTTiers As Variant
Dim vTSite As Variant
Dim vTAdresse As Variant
Dim vTRoleTiers As Variant
Dim vTZReassureur As Variant
Dim vTZCourtier As Variant
Dim args(1) As Variant
Dim vT1000 As Variant
Dim L1000FindObject_RC As Variant
Dim crArgsValide As Byte
Dim Ligne As Integer
On Error GoTo Erreur
L1000TiersGerer = True
iClassManager.BeginTran
Select Case Methode
Case METHODE_AJOUTER
Set vTTiers = iClassManager.CreateObject("TTiers")
Set vTSite = iClassManager.CreateObject("TSite")
vTSite.Caption = "SITE"
vTSite.code = "SITE"
vTSite.oidTiers = vTTiers.instanceoid
'ou vTTiers.sitesListe.AddRef vTSite
Set vTAdresse = iClassManager.CreateObject("TAdresse")
vTAdresse.NomRueVoie = Trim(SiteAdresse)
vTAdresse.ComplementAdresse = Trim(SiteAdresseComplement)
vTAdresse.CodePostal = Trim(SiteCP)
vTAdresse.Ville = Trim(SiteVille)
vTSite.oidAdresse = vTAdresse.instanceoid
args(0) = Trim(SiteCodePays)
Ligne = 2
Set vT1000 = iClassManager.FindObject("TPays", "codeISO=%1", "codeISO", True, args)
vTAdresse.oidPays = vT1000.instanceoid
vTTiers.oidPays = vT1000.instanceoid
Set vTZReassureur = iClassManager.CreateObject("TZReassureur")
vTZReassureur.Caption = Right(Trim(TiersCode), 5)
vTZReassureur.libelle = Trim(TiersCode)
vTTiers.oidreassureur = vTZReassureur.instanceoid
Set vTZCourtier = iClassManager.CreateObject("TZCourtier")
vTZCourtier.Caption = Left(Trim(TiersCode), 5)
vTZCourtier.libelle = Trim(TiersCode)
vTTiers.oidcourtier = vTZCourtier.instanceoid
vTTiers.Caption = Trim(TiersLibelle)
vTTiers.code = Trim(TiersCode)
args(0) = "CHQ1"
Set vT1000 = iClassManager.FindObject("TEcheancement", "code=%1", "Caption", True, args)
vTTiers.oidecheancementDecaissement = vT1000.instanceoid
args(0) = "CHQ1"
Set vT1000 = iClassManager.FindObject("TEcheancement", "code=%1", "caption", True, args)
vTTiers.oidecheancementEncaissement = vT1000.instanceoid
args(0) = "CHQ"
Set vT1000 = iClassManager.FindObject("TModeReglement", "code=%1", "caption", True, args)
vTTiers.oidmodeReglementDecaissement = vT1000.instanceoid
args(0) = "CHQ"
Set vT1000 = iClassManager.FindObject("TModeReglement", "code=%1", "caption", True, args)
vTTiers.oidmodeReglementEncaissement = vT1000.instanceoid
If RoleTiersReassureur Then
Set vTRoleTiers = iClassManager.CreateObject("TFournisseur")
vTRoleTiers.oidTiers = vTTiers.instanceoid
'ou vTTiers.RoleTiersListe.AddRef vTRoleTiers
vTRoleTiers.oidfournisseurAPayer = vTRoleTiers.instanceoid
' vTRoleTiers.oidsiteprivilegie = vTSite.instanceoid
End If
If RoleTiersCourtier Then
Set vTRoleTiers = iClassManager.CreateObject("TClient")
vTRoleTiers.oidTiers = vTTiers.instanceoid
'ou vTTiers.RoleTiersListe.AddRef vTRoleTiers
vTRoleTiers.oidClientPayeur = vTRoleTiers.instanceoid
' vTRoleTiers.oidsitePriviligie = vTSite.instanceoid
End If
If RoleTiersCedant Then
Set vTRoleTiers = iClassManager.CreateObject("TSalarie")
vTRoleTiers.oidTiers = vTTiers.instanceoid
'ou vTTiers.RoleTiersListe.AddRef vTRoleTiers
' vTRoleTiers.oidsitePriviligie = vTSite.instanceoid
End If
If RoleTiersCoassureur Then
Set vTRoleTiers = iClassManager.CreateObject("TTiersDivers")
vTRoleTiers.oidTiers = vTTiers.instanceoid
'ou vTTiers.RoleTiersListe.AddRef vTRoleTiers
' vTRoleTiers.oidsitePriviligie = vTSite.instanceoid
End If
Case METHODE_MODIFIER, METHODE_SUPPRIMER
args(0) = Trim(TiersCode)
Ligne = 1
Set vTTiers = iClassManager.FindObject("TTiers", "code=%1", "", True, args)
Ligne = 0
If Methode = METHODE_MODIFIER Then
' crArgsValide = ArgsValide(Methode)
' If Not crArgsValide Then
' L1000TiersGerer = crArgsValide
' Exit Function
' End If
If TiersLibelle <> "" Then
vTTiers.Caption = Trim(TiersLibelle)
End If
args(0) = Trim(vTTiers.oid)
' args(1) = "SITE"
Set vTSite = iClassManager.FindObject("TSite", "oidTiers=%1", "oidTiers", True, args)
args(0) = Trim(vTSite.oidAdresse)
Set vTAdresse = iClassManager.FindObject("TAdresse", "oid=%1", "oid", True, args)
If SiteAdresse <> "" Then
vTAdresse.NomRueVoie = Trim(SiteAdresse)
End If
If SiteAdresseComplement <> "" Then
vTAdresse.ComplementAdresse = Trim(SiteAdresseComplement)
End If
If SiteCP <> "" Then
vTAdresse.CodePostal = Trim(SiteCP)
End If
If SiteVille <> "" Then
vTAdresse.Ville = Trim(SiteVille)
End If
If SiteCodePays <> "" Then
args(0) = Trim(SiteCodePays)
Ligne = 2
Set vT1000 = iClassManager.FindObject("TPays", "codeOSCE=%1", "", True, args)
vTAdresse.oidPays = vT1000.instanceoid
vTTiers.oidPays = vT1000.instanceoid
End If
Else
vTTiers.Delete = True
End If
End Select
On Error GoTo 0
On Error Resume Next
iClassManager.Commit
If Err.Number <> 0 Then
L1000TiersGerer = Err.Number
iClassManager.RollBack
If MsgErreur Then
MsgBox Err.Number & " : " & Err.Description & " => iClassManager.RollBack", vbCritical
End If
Else
If MsgErreur Then
Select Case Methode
Case METHODE_AJOUTER
MsgBox "'TTiers " & TiersCode & "' créé ... => iClassManager.Commit", vbInformation
Case METHODE_MODIFIER
MsgBox "'TTiers " & TiersCode & "' modifié ... => iClassManager.Commit", vbInformation
Case METHODE_SUPPRIMER
MsgBox "'TTiers " & TiersCode & "' supprimé ... => iClassManager.Commit", vbInformation
End Select
End If
L1000TiersGerer = True
End If
Exit Function
Erreur:
'------
Select Case Ligne
Case 1
L1000TiersGerer = 521
iClassManager.RollBack
Exit Function
Case 2
L1000TiersGerer = 522
iClassManager.RollBack
Exit Function
End Select
L1000TiersGerer = Err.Number
If MsgErreur Then
MsgBox Err.Number & " : " & Err.Description, vbCritical
End If
End Function
Droide
DocteurClick
Messages postés
3
Date d'inscription
mercredi 16 avril 2003
Statut
Membre
Dernière intervention
16 mai 2003
16 mai 2003 à 09:42
16 mai 2003 à 09:42
En fait, j'ai fini par résoudre mes problèmes : je devait en fait modifier des documents en les transformant et je n'avait pas rempli tous les champs obligatoires ...
Par exemple,transformer un Bon de Commande en Bon de Livraison.
J'utilise donc une base ODBC et j'ai ajouter les tables F_ARTICLES,F_DOCENTETE et F_DOCLIGNE ...
Or, comme je suis novice dans ce domaine, je ne sais pas d'ou vient l'erreur qui t'embète ... je suis désolé mais je crain de ne pouvoir t'aider ... :-(
Merci d'avoir lu mon message quand meme.
voilà le code que j'utilise pour modifier les documents (si tu veu t'en inspirer ...
'Code de transformation de Document
Dim L As Long
L = 0
Dim i As Integer
Dim pb As Boolean
pb = False
'On remet la table temporaire à zéro :
qExe = "DELETE * FROM TblListDocTmp;"
BaseMdb.Execute (qExe)
'Je récupère dans TblListDocTmp les informations sur les documents et les articles des documents précédants suivant le domaine :
qExe = "INSERT INTO TblListDocTmp (Piece,Code,Design,Qte,PU,[Date],[DteLivr],Client) SELECT F_DOCENTETE.DO_PIECE,F_DOCLIGNE.AR_REF,F_DOCLIGNE.DL_DESIGN,F_DOCLIGNE.DL_QTE,F_DOCLIGNE.DL_PRIXUNITAIRE,F_DOCENTETE.DO_DATE,F_DOCENTETE.DO_DATELIVR,F_DOCENTETE.DO_TIERS FROM F_DOCENTETE INNER JOIN F_DOCLIGNE ON (F_DOCENTETE.DO_DOMAINE=F_DOCLIGNE.DO_DOMAINE) AND (F_DOCENTETE.DO_TYPE=F_DOCLIGNE.DO_TYPE) AND (F_DOCENTETE.DO_PIECE=F_DOCLIGNE.DO_PIECE) WHERE ((F_DOCLIGNE.DO_DOMAINE=" & DomDoc & ")) AND ((F_DOCLIGNE.DO_TYPE=" & TypDoc & ")) AND ((F_DOCENTETE.DO_PIECE='" & NoPiece & "')) ORDER BY F_DOCLIGNE.AR_REF;"
BaseMdb.Execute (qExe)
'Création de l'entête du nouveau document :
Select Case DomDoc
Case 2 'Document de stock
qExe = "INSERT INTO F_DOCENTETE (DO_DOMAINE, DO_TYPE, DO_PIECE, DO_DATE, DE_NO, DO_TIERS, DO_REF) SELECT " & DomDoc & "," & NouvTypDoc & ",'" & NouvRefPiece & "', DO_DATE,DE_NO,DO_TIERS,DO_REF FROM F_DOCENTETE WHERE DO_PIECE='" & NoPiece & "';"
BaseMdb.Execute (qExe)
Case Else 'ou autre document (vente, achat)
qExe = "INSERT INTO F_DOCENTETE (DO_DOMAINE,DO_TYPE,DO_PIECE,DO_DATE,DE_NO,DO_TIERS,CT_NUMPAYEUR,DO_EXPEDIT,DO_CONDITION,DO_TARIF,DO_TYPECOLIS,N_CATCOMPTA,CG_NUM,DO_STATUT,DO_BLFACT,DO_PERIOD,LI_NO,DO_DATELIVR,RE_NO,DO_REF) SELECT " & DomDoc & "," & NouvTypDoc & ",'" & NouvRefPiece & "', DO_DATE,DE_NO,DO_TIERS,CT_NUMPAYEUR,DO_EXPEDIT,DO_CONDITION,DO_TARIF,DO_TYPECOLIS,N_CATCOMPTA,CG_NUM,DO_STATUT,DO_BLFACT,DO_PERIOD,LI_NO,DO_DATELIVR,RE_NO,DO_REF FROM F_DOCENTETE WHERE DO_PIECE='" & NoPiece & "';"
BaseMdb.Execute (qExe)
End Select
'Je recopie tous les articles du document précédant pour les utiliser dans le nouveau document :
qSql = "SELECT * From TblListDocTmp;"
Set RSArt = BaseMdb.OpenRecordset(qSql, dbOpenDynaset)
qSql = "SELECT F_ARTICLE.AR_REF As [Code],F_ARTICLE.AR_SUIVISTOCK As [Suivi] From F_ARTICLE;"
Set RSSerie = BaseMdb.OpenRecordset(qSql, dbOpenSnapshot)
qSql = "SELECT F_ARTSTOCK.AR_REF As [Code],F_ARTSTOCK.AS_QTESTO As [Qte],F_ARTSTOCK.AS_QTERES As [QteR],F_ARTSTOCK.DE_NO as [No] From F_ARTSTOCK;"
Set RSQteR = BaseMdb.OpenRecordset(qSql, dbOpenSnapshot)
UpdateRSArt
'Insertion des articles dans le nouveau document :
If Not RSArt.EOF Then
RSArt.MoveLast
RSArt.MoveFirst
For i = 1 To RSArt.RecordCount
L = L + 1 If ((RSArt("Suivi") 1) Or (RSArt("Suivi") 3)) Then
NumSerie = "NS" & Mid(RSArt("Code"), 2) & (100 * i)
End If
'If RSArt("Qte") > RSArt("QteR") Then 'Il n'y as plus assez de quantité en stock pour l'article en cours de traitement
' Msg = "Il n'y a plus assez d'articles en stock pour cette référence : " & RSArt("Code") & Chr(13) & "Quantité demandée : " & RSArt("Qte") & Chr(13) & "Quantité réelle en stock : " & RSArt("QteR")
' Style = vbOKOnly + vbCritical + vbDefaultButton1
' Title = "Stock insufisant !"
' Rep = MsgBox(Msg, Style, Title)
' pb = True
'End If
If Not pb Then
Select Case DomDoc 'On effectue en fait une commande SQL différente suivant le domaine du document
Case 2 'Si c'est un document de stock, alors on effectue cette requète
qExe = "INSERT INTO F_DOCLIGNE (DL_MVTSTOCK,DE_NO,DO_DOMAINE,DO_TYPE,CT_NUM,DO_PIECE,DL_LIGNE,AR_REF,EU_QTE,DL_VALORISE,DL_PRIXUNITAIRE,DL_QTE,DO_DATE,DL_DESIGN,DL_NO,LS_NOSERIE) VALUES (" & MvtStock & ",1," & DomDoc & "," & NouvTypDoc & ",'" & RSArt("Client") & "','" & NouvRefPiece & "'," & L & ",'" & RSArt("Code") & "'," & RSArt("Qte") & ",1," & MontantToMontantSql(RSArt("PU")) & "," & RSArt("Qte") & "," & DateStrToDateSql(Format(RSArt("Date"), "dd/mm/yy")) & ",'" & RSArt("Design") & "',0,'" & NumSerie & "');"
BaseMdb.Execute (qExe)
Case Else 'Si c'est un autre document (vente,achat), on effectue cette requète.
qExe = "INSERT INTO F_DOCLIGNE (DL_MVTSTOCK,DE_NO,DO_DOMAINE,DO_TYPE,CT_NUM,DO_PIECE,DL_LIGNE,AR_REF,EU_QTE,DL_VALORISE,DL_PRIXUNITAIRE,DL_QTE,DO_DATELIVR,DO_DATE,DL_DESIGN,DO_REF,DL_DATEBL,DL_NO,LS_NOSERIE) VALUES (" & MvtStock & ",1," & DomDoc & "," & NouvTypDoc & ",'" & RSArt("Client") & "','" & NouvRefPiece & "'," & L & ",'" & RSArt("Code") & "'," & RSArt("Qte") & ",1," & MontantToMontantSql(RSArt("PU")) & "," & RSArt("Qte") & "," & DateStrToDateSql(Format(RSArt("DteLivr"), "dd/mm/yy")) & "," & DateStrToDateSql(Format(RSArt("Date"), "dd/mm/yy")) & ",'" & RSArt("Design") & "','essais ODBC'," & DateStrToDateSql(Format(RSArt("Date"), "dd/mm/yy")) & ",0,'" & NumSerie & "');"
BaseMdb.Execute (qExe)
End Select
End If
RSArt.MoveNext
Next i
End If
RSArt.Close
'Message d'avertissement pour l'utilisateur : on efface l'original du document.
If Not pb Then
Msg = "ATTENTION ! Le document original doit être effacé aprés la transformation." & Chr(13) & "Souhaitez-vous effacer le document " & NoPiece & " aprés avoir créer le document " & NouvRefPiece & " ?"
Style = vbYesNo + vbExclamation + vbDefaultButton1
Title = "Avertissement !"
Rep = MsgBox(Msg, Style, Title)
If Rep = vbNo Then
Exit Sub
End If
If Rep = vbYes Then
'Traitement d'effecement des données du document original
qExe = "DELETE * FROM F_DOCLIGNE WHERE (F_DOCLIGNE.DO_PIECE='" & NoPiece & "') AND (F_DOCLIGNE.DO_DOMAINE=" & DomDoc & ") AND (F_DOCLIGNE.DO_TYPE=" & TypDoc & ");"
BaseMdb.Execute (qExe)
qExe = "DELETE * FROM F_DOCENTETE WHERE (F_DOCENTETE.DO_PIECE='" & NoPiece & "') AND (F_DOCENTETE.DO_DOMAINE=" & DomDoc & ") AND (F_DOCENTETE.DO_TYPE=" & TypDoc & ");"
BaseMdb.Execute (qExe)
End If
End If
avant d'utiliser la base on doit faire :
DoEvents
CompacteDataBase ChemBase, True, True
DoEvents
Set BaseMdb = OpenDatabase(ChemBase, False, False)
DoEvents
@+ et bonne chance pour la résolution de ton problème.
Par exemple,transformer un Bon de Commande en Bon de Livraison.
J'utilise donc une base ODBC et j'ai ajouter les tables F_ARTICLES,F_DOCENTETE et F_DOCLIGNE ...
Or, comme je suis novice dans ce domaine, je ne sais pas d'ou vient l'erreur qui t'embète ... je suis désolé mais je crain de ne pouvoir t'aider ... :-(
Merci d'avoir lu mon message quand meme.
voilà le code que j'utilise pour modifier les documents (si tu veu t'en inspirer ...
'Code de transformation de Document
Dim L As Long
L = 0
Dim i As Integer
Dim pb As Boolean
pb = False
'On remet la table temporaire à zéro :
qExe = "DELETE * FROM TblListDocTmp;"
BaseMdb.Execute (qExe)
'Je récupère dans TblListDocTmp les informations sur les documents et les articles des documents précédants suivant le domaine :
qExe = "INSERT INTO TblListDocTmp (Piece,Code,Design,Qte,PU,[Date],[DteLivr],Client) SELECT F_DOCENTETE.DO_PIECE,F_DOCLIGNE.AR_REF,F_DOCLIGNE.DL_DESIGN,F_DOCLIGNE.DL_QTE,F_DOCLIGNE.DL_PRIXUNITAIRE,F_DOCENTETE.DO_DATE,F_DOCENTETE.DO_DATELIVR,F_DOCENTETE.DO_TIERS FROM F_DOCENTETE INNER JOIN F_DOCLIGNE ON (F_DOCENTETE.DO_DOMAINE=F_DOCLIGNE.DO_DOMAINE) AND (F_DOCENTETE.DO_TYPE=F_DOCLIGNE.DO_TYPE) AND (F_DOCENTETE.DO_PIECE=F_DOCLIGNE.DO_PIECE) WHERE ((F_DOCLIGNE.DO_DOMAINE=" & DomDoc & ")) AND ((F_DOCLIGNE.DO_TYPE=" & TypDoc & ")) AND ((F_DOCENTETE.DO_PIECE='" & NoPiece & "')) ORDER BY F_DOCLIGNE.AR_REF;"
BaseMdb.Execute (qExe)
'Création de l'entête du nouveau document :
Select Case DomDoc
Case 2 'Document de stock
qExe = "INSERT INTO F_DOCENTETE (DO_DOMAINE, DO_TYPE, DO_PIECE, DO_DATE, DE_NO, DO_TIERS, DO_REF) SELECT " & DomDoc & "," & NouvTypDoc & ",'" & NouvRefPiece & "', DO_DATE,DE_NO,DO_TIERS,DO_REF FROM F_DOCENTETE WHERE DO_PIECE='" & NoPiece & "';"
BaseMdb.Execute (qExe)
Case Else 'ou autre document (vente, achat)
qExe = "INSERT INTO F_DOCENTETE (DO_DOMAINE,DO_TYPE,DO_PIECE,DO_DATE,DE_NO,DO_TIERS,CT_NUMPAYEUR,DO_EXPEDIT,DO_CONDITION,DO_TARIF,DO_TYPECOLIS,N_CATCOMPTA,CG_NUM,DO_STATUT,DO_BLFACT,DO_PERIOD,LI_NO,DO_DATELIVR,RE_NO,DO_REF) SELECT " & DomDoc & "," & NouvTypDoc & ",'" & NouvRefPiece & "', DO_DATE,DE_NO,DO_TIERS,CT_NUMPAYEUR,DO_EXPEDIT,DO_CONDITION,DO_TARIF,DO_TYPECOLIS,N_CATCOMPTA,CG_NUM,DO_STATUT,DO_BLFACT,DO_PERIOD,LI_NO,DO_DATELIVR,RE_NO,DO_REF FROM F_DOCENTETE WHERE DO_PIECE='" & NoPiece & "';"
BaseMdb.Execute (qExe)
End Select
'Je recopie tous les articles du document précédant pour les utiliser dans le nouveau document :
qSql = "SELECT * From TblListDocTmp;"
Set RSArt = BaseMdb.OpenRecordset(qSql, dbOpenDynaset)
qSql = "SELECT F_ARTICLE.AR_REF As [Code],F_ARTICLE.AR_SUIVISTOCK As [Suivi] From F_ARTICLE;"
Set RSSerie = BaseMdb.OpenRecordset(qSql, dbOpenSnapshot)
qSql = "SELECT F_ARTSTOCK.AR_REF As [Code],F_ARTSTOCK.AS_QTESTO As [Qte],F_ARTSTOCK.AS_QTERES As [QteR],F_ARTSTOCK.DE_NO as [No] From F_ARTSTOCK;"
Set RSQteR = BaseMdb.OpenRecordset(qSql, dbOpenSnapshot)
UpdateRSArt
'Insertion des articles dans le nouveau document :
If Not RSArt.EOF Then
RSArt.MoveLast
RSArt.MoveFirst
For i = 1 To RSArt.RecordCount
L = L + 1 If ((RSArt("Suivi") 1) Or (RSArt("Suivi") 3)) Then
NumSerie = "NS" & Mid(RSArt("Code"), 2) & (100 * i)
End If
'If RSArt("Qte") > RSArt("QteR") Then 'Il n'y as plus assez de quantité en stock pour l'article en cours de traitement
' Msg = "Il n'y a plus assez d'articles en stock pour cette référence : " & RSArt("Code") & Chr(13) & "Quantité demandée : " & RSArt("Qte") & Chr(13) & "Quantité réelle en stock : " & RSArt("QteR")
' Style = vbOKOnly + vbCritical + vbDefaultButton1
' Title = "Stock insufisant !"
' Rep = MsgBox(Msg, Style, Title)
' pb = True
'End If
If Not pb Then
Select Case DomDoc 'On effectue en fait une commande SQL différente suivant le domaine du document
Case 2 'Si c'est un document de stock, alors on effectue cette requète
qExe = "INSERT INTO F_DOCLIGNE (DL_MVTSTOCK,DE_NO,DO_DOMAINE,DO_TYPE,CT_NUM,DO_PIECE,DL_LIGNE,AR_REF,EU_QTE,DL_VALORISE,DL_PRIXUNITAIRE,DL_QTE,DO_DATE,DL_DESIGN,DL_NO,LS_NOSERIE) VALUES (" & MvtStock & ",1," & DomDoc & "," & NouvTypDoc & ",'" & RSArt("Client") & "','" & NouvRefPiece & "'," & L & ",'" & RSArt("Code") & "'," & RSArt("Qte") & ",1," & MontantToMontantSql(RSArt("PU")) & "," & RSArt("Qte") & "," & DateStrToDateSql(Format(RSArt("Date"), "dd/mm/yy")) & ",'" & RSArt("Design") & "',0,'" & NumSerie & "');"
BaseMdb.Execute (qExe)
Case Else 'Si c'est un autre document (vente,achat), on effectue cette requète.
qExe = "INSERT INTO F_DOCLIGNE (DL_MVTSTOCK,DE_NO,DO_DOMAINE,DO_TYPE,CT_NUM,DO_PIECE,DL_LIGNE,AR_REF,EU_QTE,DL_VALORISE,DL_PRIXUNITAIRE,DL_QTE,DO_DATELIVR,DO_DATE,DL_DESIGN,DO_REF,DL_DATEBL,DL_NO,LS_NOSERIE) VALUES (" & MvtStock & ",1," & DomDoc & "," & NouvTypDoc & ",'" & RSArt("Client") & "','" & NouvRefPiece & "'," & L & ",'" & RSArt("Code") & "'," & RSArt("Qte") & ",1," & MontantToMontantSql(RSArt("PU")) & "," & RSArt("Qte") & "," & DateStrToDateSql(Format(RSArt("DteLivr"), "dd/mm/yy")) & "," & DateStrToDateSql(Format(RSArt("Date"), "dd/mm/yy")) & ",'" & RSArt("Design") & "','essais ODBC'," & DateStrToDateSql(Format(RSArt("Date"), "dd/mm/yy")) & ",0,'" & NumSerie & "');"
BaseMdb.Execute (qExe)
End Select
End If
RSArt.MoveNext
Next i
End If
RSArt.Close
'Message d'avertissement pour l'utilisateur : on efface l'original du document.
If Not pb Then
Msg = "ATTENTION ! Le document original doit être effacé aprés la transformation." & Chr(13) & "Souhaitez-vous effacer le document " & NoPiece & " aprés avoir créer le document " & NouvRefPiece & " ?"
Style = vbYesNo + vbExclamation + vbDefaultButton1
Title = "Avertissement !"
Rep = MsgBox(Msg, Style, Title)
If Rep = vbNo Then
Exit Sub
End If
If Rep = vbYes Then
'Traitement d'effecement des données du document original
qExe = "DELETE * FROM F_DOCLIGNE WHERE (F_DOCLIGNE.DO_PIECE='" & NoPiece & "') AND (F_DOCLIGNE.DO_DOMAINE=" & DomDoc & ") AND (F_DOCLIGNE.DO_TYPE=" & TypDoc & ");"
BaseMdb.Execute (qExe)
qExe = "DELETE * FROM F_DOCENTETE WHERE (F_DOCENTETE.DO_PIECE='" & NoPiece & "') AND (F_DOCENTETE.DO_DOMAINE=" & DomDoc & ") AND (F_DOCENTETE.DO_TYPE=" & TypDoc & ");"
BaseMdb.Execute (qExe)
End If
End If
avant d'utiliser la base on doit faire :
DoEvents
CompacteDataBase ChemBase, True, True
DoEvents
Set BaseMdb = OpenDatabase(ChemBase, False, False)
DoEvents
@+ et bonne chance pour la résolution de ton problème.
vbpedro
Messages postés
1
Date d'inscription
jeudi 18 novembre 2004
Statut
Membre
Dernière intervention
19 novembre 2004
19 nov. 2004 à 11:35
19 nov. 2004 à 11:35
Salut
Qui DLL en références en vb tu utilises pour avoir accès à:
Ligne1000.coClassManager
Ligne1000.L1000MasterContext
Ligne1000.MasterConnectProperties
Ligne1000.ApplicationConnectProperties
Merci d'avance.
Pedro
Qui DLL en références en vb tu utilises pour avoir accès à:
Ligne1000.coClassManager
Ligne1000.L1000MasterContext
Ligne1000.MasterConnectProperties
Ligne1000.ApplicationConnectProperties
Merci d'avance.
Pedro
