Incrémentation du numéro de facture

Version imprimable

23/05/2008, 10h21
Toison

1 pièce(s) jointe(s)

Incrémentation du numéro de facture

Bonjour,

Retour de congés et prise de contact, mais déjà une question.
Dans le fichier joint, je voudrais voir incrémenté le numéro de la facture à l'ouverture du fichier.

Besoin d'aide !

Merci!
Toison
23/05/2008, 11h32
mordrhim
Bonjour,

Pour incrémenter une valeur lors de l'ouverture de fichier :
Code:

1 2 3 Private Sub Workbook_Open() Range("Ton_Range") = Range("Ton_Range") +1 End Sub
Avec "Ton_Range" l'adresse de la cellule à incrémenter.
Cette sub devra être placée dans ThisWorkbook
23/05/2008, 11h36
Godzestla
Salut,

il faut dans l'onglet Thisworkbook ajouter un appel à ta procédure numfact dans l'évènement Workbook_open
Code:

1 2 3 Private Sub Workbook_Open() numFact End Sub
Je l'ai mis dans ton fichier.
23/05/2008, 11h48
Invité

Bonjour Toison,

Une précision à toutes fins utiles et qui n'a rien a voir avec votre demande :

je pense que vous devriez utiliser la fonction "Arrondi" pour le calcul du prix unitaire ou dans "Outils", "Options" onglet "Calcul" cocher "Calcul avec la précision au format affiché".

En effet, il peut paraître bizarre (surtout sur un document comptable) que 30*17,06 donne un résultat de 511,85 au lieu de 511,80.
23/05/2008, 13h50
Didier Gonard

Bonjour,

le sujet parait comme résolu, mais bon...

S'il s'agit de traiter des factures avec une incrémentation automatique des numéros, il est primordial, à mon sens, de travailler à partir d'un modèle (.xlt), sinon c'est la porte ouverte à tous les dangers, notamment à l'aire de la dématérialisation (on scanne pour archiver numériquement, en gros si besoin), c'est dur de considérer que si on doit consulter une facture, on aille fouiller dans les papiers alors que quelques clics...
Dans l'état actuel des choses, si on ouvre la facture, on incrémente son N° qui n'est plus le bon etc....
Donc, mieux vaut travailler sur un .xlt dont le workbook open ne s'activera que si on est bien sur un .xlt (ou autre pour 2007).

cordialement,

Didier

bonjour à tous

personnellement j'utilise la macro suivante pour obtenir un numéro de devis.
La macro inscrit le nouveau numéro, ainsi que la date du jour dans le classeur NoDevis.xlsm.
Le principe reste le même pour une facture.
Cette macro se déclenche au double clique dans une cellule, si et seulement si la cellule est vide.

Le code ADO n'est probablement pas optimisé.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Sub NoDevis()
   Dim Cn As ADODB.Connection
   Dim Cd As ADODB.Command
   Dim Rst As ADODB.Recordset
   Dim CheminNoDevis As String
   Dim NomFeuille As String
   Dim NomCol As String
   Dim Cellule As String
   Dim i As Integer
 
   CheminNoDevis = "D:\...\...\NoDevis.xlsm"
 
   NomFeuille = "Feuil1"
 
   Set Cn = New ADODB.Connection
   ' pour Xl 2007
   Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
      "Data Source=" & CheminNoDevis & ";" & _
      "Extended Properties=""Excel 12.0;HDR=no;"""
   'Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & CheminNoDevis & ";" & _
      "Extended Properties=""Excel 8.0;HDR=No;"";"
 
   Set Cd = New ADODB.Command
   Cd.ActiveConnection = Cn
 
      '------------------
      Cd.CommandText = "SELECT * FROM [" & NomFeuille & "$]"
      Set Rst = New ADODB.Recordset
      Rst.Open Cd, , adOpenKeyset, adLockOptimistic
      Dim NumeroDevis As Long
      NumeroDevis = Rst.RecordCount + 1
      'MsgBox NumeroDevis
      Rst.Close
      Set Rst = Nothing
 
'------------------------
   Dim tablo(1 To 2) As Variant
   tablo(1) = NumeroDevis
   tablo(2) = Date
 
   For i = 1 To UBound(tablo)
      Cellule = Cells(NumeroDevis, i).Address(0, 0) & ":" & Cells(NumeroDevis, i).Address(0, 0)
      Cd.CommandText = "SELECT * FROM [" & NomFeuille & "$" & Cellule & "]"
      Set Rst = New ADODB.Recordset
      Rst.Open Cd, , adOpenKeyset, adLockOptimistic
      Rst(0).Value = tablo(i)
      Rst.Update
   Next i
   Cn.Close
 
   Set Cn = Nothing
   Set Cd = Nothing
   Set Rst = Nothing
   [B2] = NumeroDevis
End Sub

23/05/2008, 14h40
Toison

Grand merci
à Godzestla pour le code
à Jacques_Jean pour le conseil judicieux sur le format des chiffres.
Et enfin, merci au forum sans lequel tout ceci ne se serait pas produit.
Bonne journée !
Toison
23/05/2008, 15h09
Toison

Merci à Ormonth et Fred65200 qui ont pris la peine de répondre malgré l'état "Résolu" du problème.
Je vais faire bon usage de vos conseils et du code. Je recmercie également mordrhim.

A bientôt !
Toison