Michael DELIQUE a écrit:Voila madame !
et comme le dis Roubech tant que tout le monde est sur le même serveur ça va apres faut gérer différement
- numérotation par serveur
- serveur unique de numérotation
- Code : Tout sélectionner
Public Function CompteurPrincipal As String
'function gérant le compteur de document en l'incrémentant
'Déclaration Variable
Dim nbNumero As Long
Dim nbTaille As Integer
Dim nbDigit As Integer
Dim DocCompteur As NotesDocument
Dim DocParamCompteur As NotesDocument
Dim Prefix As String
Dim vwNumeroSystem As NotesView
On Error Goto ErreurHandle
If db Is Nothing Or Session Is Nothing Then
Set Session = New NotesSession
Set db = Session.CurrentDatabase
End If
If Trim(db.server) = "" Then
CompteurPrincipal = ""
Exit Function
End If
Set vwNumeroSystem = db.GetView("vwNumeroSystem")
If vwNumeroSystem Is Nothing Then
Error 9999,"vwNumeroSystem is nothing"
End If
vwNumeroSystem.Refresh
Set DocParamCompteur = DocSystem("CPT","PARAM")
If DocParamCompteur Is Nothing Then
Error 9999, "DocParamCompteur is Nothing"
Exit Function
End If
If Ucase(Trim(DocParamCompteur.GetItemValue("ActiveCompteur")(0))) <> "OUI" Then
CompteurPrincipal = ""
Exit Function
Else
Select Case Trim(Cstr(DocParamCompteur.GetItemValue("NbDigit")(0)))
Case "","0"
NBDigit = 0
Case Else
NBDigit=Cint(Trim(DocParamCompteur.GetItemValue("NbDigit")(0)))
End Select
End If
Prefix = ""
If Trim(DocParamCompteur.GetItemValue("Prefix")(0)) <> "" Then
Prefix = Trim(Cstr(Formulatron(DocParamCompteur, DocParamCompteur,"FlagPrefix", "Prefix",False)(0)))
End If
CompteurPrincipal = ""
'passe au numéro suivant et maj jour du doc param puis l'enregistre
Select Case Trim(Cstr(DocParamCompteur.GetItemValue("numero")(0)))
Case "","0"
NBNumero=1
Case Else
NBNumero=Clng(Trim(DocParamCompteur.GetItemValue("numero")(0)))+1
End Select
CompteurPrincipal = Cstr(NBNumero)
'formate le numéro => ajoute le nombre de zéro necessaire devant
If NBDigit<1 Then
Call DocParamCompteur.Save(True,False)
Exit Function
End If
NBTaille= Len(Trim(CompteurPrincipal))
While NBTaille<NBDigit
CompteurPrincipal = "0"+Trim(CompteurPrincipal)
NBTaille= Len(Trim(CompteurPrincipal))
Wend
CompteurPrincipal = Prefix+CompteurPrincipal
'test si un document est déjà numéroté, si rien renvoi le numéro
Set DocCompteur =vwNumeroSystem.GetFirstDocument
If DocCompteur Is Nothing Then
Call DocParamCompteur.ReplaceItemValue( "numero", nbNumero )
Call DocParamCompteur.Save(True,False)
Exit Function
End If
Set DocCompteur = Nothing
'boucle jusqu'a ce que le numéro n'est plus de doublon
While Not DocCompteur Is Nothing
CompteurPrincipal = ""
nbNumero=nbNumero+1
CompteurPrincipal= Cstr(nbNumero)
nbTaille= Len(Trim(CompteurPrincipal))
While nbTaille<nbDigit
CompteurPrincipal = "0"+Trim(CompteurPrincipal)
nbTaille= Len(Trim(CompteurPrincipal))
Wend
CompteurPrincipal = Prefix+CompteurPrincipal
Set DocCompteur = vwNumeroSystem.GetDocumentByKey(CompteurPrincipal,True)
Wend
'enregistre le derniere numéro
Call DocParamCompteur.ReplaceItemValue( "numero", nbNumero )
Call DocParamCompteur.Save(True,False)
Set DocCompteur = Nothing
Set DocParamCompteur = Nothing
Exit Function
ErreurHandle:
Set DocCompteur = Nothing
Msgbox "("+Structure_Log+" : "+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur N° " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
Set Session = New NotesSession
Call Error_LOG(Session.CurrentDatabase,Cstr(Session.Username),Cstr(Now),Structure_Log,Cstr(Getthreadinfo(10)),Cstr(Getthreadinfo (1)),Cstr(Err),Cstr(Error),Cstr(Erl))
CompteurPrincipal = ""
Exit Function
End Function
Bonjour, merci mais mais je préfère Monsieur!
Cela dit Michael, tu pourrais mettre la fonction Formulatron pour voir ce que çà donne!
Sinon j'ai glané çà sur le net:
https://www.ibm.com/developerworks/lotus/library/ls-sequential_numbers/side1.htmlIl permet de gérer justement les applications sur des serveurs multiples!
cdt
Mr. camille
Publié: 26 Mars 2012 à 14:10