Discussion :

[nicdodo]

Bonjour,
cela fait maintenant deux à trois semaines que j'ai découvert le vb et ça à changé profondement ma maniere de travailler sur excel.
J'ai découvert par hasard grace à un tuto et depuis j'ai pu réaliser un vieux projet que j'avais en tete pour ma société de livraison, un logiciel de prise de commande avec fichier client.
Grace à l'aide des membres du site j'ai pu réaliser mon projet et depuis sa mise en place c'est devenu un outil indispensable. Maintenant j'ai fini la partie prise de commande et intégration des clients il me manque la partie comptabilité indispensable pour un logicile de caisse.
Pour cela je sollicite encore votre aide pour une opération qui me semble compliqué de réaliser par moi meme car les recherches sur le sauvegarder sous que j'ai trouvé sur internet de sont pas assez complete.

Donc j'explique le contexte. Sur ma feuille "facture", ma facture correspond au cellules A8:F37 .
- En E8 il y'a la date afficher grace grace à la formule "=maintenant" et la cellule correspondante au format date
- Et en cellule B9 le numero de commande sachant qu'a chaque commande prise le numero augmente de 1 (logique) notté par le code ci dessous

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Dim cel As Range
Set cel = ThisWorkbook.Sheets(1).Range("B9")
cel.Value = cel.Value + 1

J'ai notté précisement tout au cas ou cela puisse avoir une infleunce.

En gros dans un dossier séparer j'aimerais que l'enregistrement fasse plusierus chose automatiquement :
qu'il me cré un nouveau fichier xls avec pour nom la date en E8, puis que dans ce fichier il cré un nom de feuille correspondant au numero de commande en B9
et qu'il copie les cellules (A8:F37) dans la feuiile corespondante.
Il peut m'arriver d'avoir une centaine de commandes dans une journée, j'aimerais donc que par exemple la journée si elle commence au numero de commande 60 quand j'enregistre la premiere commande un fichier "xls" se cré avec pour nom la date du jour (exemple 18/03/2012) puis que les cellules (A8:F37) soit copié dans le fichier 18/03/2012.xls dans une feuille nommée 60
puis que le 61 soit enregistrer dans ce meme fichier 18/03/2012 mais dans une 2eme feuille qui se nommera automatiquement 61 et ainsi de suite.
Le lendemain il faudra que ça fasse la meme opération pour le 19 et ainsi de suite.
Est ce possible à réailiser?

[mercatog]

3 on 1
On archive les totaux dans la feuille "Z Journalier", on archive la facture dans le classeur du jour et on efface la facture

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Sub Enregistre()
Dim Chemin As String, Fichier As String, Fact As String
Dim Wbk As Workbook
Dim Sh As Worksheet
 
Application.ScreenUpdating = False
Chemin = ThisWorkbook.Path & "\"                 'Dossier de sauvegarde = celui du fichier FACTURE
Fichier = Format(Date, "dd-mm-yyyy") & ".xls"    'nom du fichier archive
Fact = Worksheets("FACTURE").Range("B9").Value   'N° Facture
If Dir(Chemin & Fichier) = "" Then               'Si le classeur n'existe pas, on le crée et on nomme la première feuille avec le N° de facture
    Set Wbk = Workbooks.Add(1)
    Set Sh = Wbk.Worksheets(1)
    Sh.Name = Fact
    Wbk.SaveAs Chemin & Fichier
Else                                             'Si le classeur existe, on l'ouvre
    Set Wbk = Workbooks.Open(Chemin & Fichier)
    If Not Existe(Wbk, Fact) Then                'Si la feuille N° Facture n'existe pas, on l'ajoute dans le classeur qu'on vient d'ouvrir
        Set Sh = Wbk.Worksheets.Add(after:=Wbk.Sheets(Wbk.Sheets.Count))
        Sh.Name = Fact
    Else
        Set Sh = Wbk.Worksheets(Fact)
    End If
End If
 
ThisWorkbook.Worksheets("FACTURE").Range("A8:F37").Copy Sh.Range("A1")
Sh.UsedRange.Value = Sh.UsedRange.Value
Set Sh = Nothing
Wbk.Close True
Set Wbk = Nothing
Efface
End Sub
 
Private Function Existe(ByVal Wbk As Workbook, ByVal Str As String) As Boolean
Dim Sh As Worksheet
 
For Each Sh In Wbk.Sheets
    If UCase(Sh.Name) = UCase(Str) Then
        Existe = True
        Exit For
    End If
Next Sh
End Function
 
Sub Efface()
Dim NewLig As Long
 
Application.ScreenUpdating = False
With Worksheets("Z JOURNALIER")
    NewLig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    .Range("A:B").UnMerge
    With .Range("A" & NewLig)
        .Value = Worksheets("FACTURE").Range("B9").Value
        .HorizontalAlignment = xlCenter
        .Borders.Weight = xlThin
    End With
 
    .Range("B" & NewLig).Value = Worksheets("FACTURE").Range("F36").Value
 
    .Range("C" & NewLig).Value = Worksheets("FACTURE").Range("F37").Value
 
    With .Range("B" & NewLig & ":C" & NewLig)
        .NumberFormat = "#,##0.00 $"
        .Borders.Weight = xlThin
    End With
End With
 
With Worksheets("FACTURE")
    With .Range("A16:E35")
        .UnMerge
        .ClearContents
        .Merge True
    End With
    .Range("F16:F35") = ""
    Union(.Range("A10:A12"), .Range("A14:A15"), .Range("B13"), .Range("D10"), .Range("D13"), .Range("F13")).Value = "/"
    With .Range("A16:F36").Font
        .Name = "Calibri"
        .Size = "11"
        .Bold = False
    End With
    .Range("B9").Value = Val(.Range("B9")) + 1
End With
End Sub

[casefayere]

Bonjour mercatog, re nicdodo

Encore bravo pour ta disponibilité et ton travail mercatog, mais,

J'ai déjà construit un fichier de ce genre pour un ami et ai préféré enregistré toutes les factures (ou devis, dans mon cas) en PDF afin de ne pas trop charger en fichiers excel et avoir un bon fichier d'archivage.

Quand une facture ou un devis est en cours d'élaboration, je crée une feuille provisoire excel sinon je l'archive en PDF.

Tout ça pour donner des idées à nicdodo, au cas où...........

Bonne journée

[nicdodo]

Mercatog encore toi qui m'aide merci.
J'ai repris ton code mais je n'ai pas compris.
Mon xls avec lequel je travail est dans le repertoite :
C:\Users\Le Green\Desktop\le green\Logicaisse
Mon repertoire dans lequel je veux enregistrer les factures par commande
C:\Users\Le Green\Desktop\le green\compta\compte journalier\bon de commandes
ou je mets les repertoire dans le code?

comme casefayere je voulais aussi te remercier pour ta disponibilité et ton aide précieuse.
Pour le PDF c'est une tres bonne idée effectivement, seulement le pdf ne permet pas de modification je crois ou alors de maniere plus compliqué qu'excel.
Il est toujours interressant de pouvoir modifier les comptes apres coup et facilement donc la solution excel peut plait tout de meme un peu plus. Mais merci pour ton idée je la trouve tres bonne

[mercatog]

Ligne 7

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Chemin = "C:\Users\Le Green\Desktop\le green\compta\compte journalier\bon de commandes\"

@ casefayere, Je suis d'accord

[nicdodo]

J'ai mis le chemin mais ça ne marche pas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Enregistre()
Dim Chemin As String, Fichier As String, Fact As String
Dim Wbk As Workbook
Dim Sh As Worksheet
 
Application.ScreenUpdating = False
Chemin = ThisWorkbook.Path & "\"                 'Dossier de sauvegarde = celui du fichier FACTURE
Fichier = Format(Date, "dd-mm-yyyy") & ".xls"    'nom du fichier archive
Fact = Worksheets("FACTURE").Range("B9").Value   'N° Facture
If Dir(Chemin & Fichier) = "C:\Users\Le Green\Desktop\le green\compta\compte journalier\bon de commandes" Then               'Si le classeur n'existe pas, on le crée et on nomme la première feuille avec le N° de facture
    Set Wbk = Workbooks.Add(1)
    Set Sh = Wbk.Worksheets(1)
    Sh.Name = Fact
    Wbk.SaveAs Chemin & Fichier
Else                                             'Si le classeur existe, on l'ouvre
    Set Wbk = Workbooks.Open(Chemin & Fichier)
    If Not Existe(Wbk, Fact) Then                'Si la feuille N° Facture n'existe pas, on l'ajoute dans le classeur qu'on vient d'ouvrir
        Set Sh = Wbk.Worksheets.Add(after:=Wbk.Sheets(Wbk.Sheets.Count))
        Sh.Name = Fact
    Else
        Set Sh = Wbk.Worksheets(Fact)
    End If
End If
 
ThisWorkbook.Worksheets("FACTURE").Range("A8:F37").Copy Sh.Range("A1")
Sh.UsedRange.Value = Sh.UsedRange.Value
Set Sh = Nothing
Wbk.Close True
Set Wbk = Nothing
Efface
End Sub

je ne comprends pas pourquoi?

[mercatog]

Tu comprends ce que tu fais?
Laisse la ligne 10 du code tranquille et modifie la ligne 7
Au lieu de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Chemin=thisworkbook.path &"\"

Mets

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Chemin="C:\Users\Le Green\Desktop\le green\compta\compte journalier\bon de commandes\"

[casefayere]

Je pense (peut-être à tort) qu'il faut vérifier l'existence du chemin, dossier par dossier,
ci-dessous, un exemple, ne pas tenir compte de toutes mes variables déclarées qui font partie d'un fichier perso et adapter suivant tes besoins :

regardes plutot du coté de ma variable "verif"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub ENREGISTRER()
Dim nomdossier As String, nomcle As String, stmessage As String, _
rep_annee As String, dateref As String, verif As String, rep_mois As String, rep_jour As String
'----------------------------------------------------------------------------------------------
nomdossier = "archives_" & ActiveSheet.Name
nomfichier = ThisWorkbook.Path
 
ChDir nomfichier 'se place sur le repertoire du programme
 
If (verif = Dir(nomfichier & "\" & nomdossier & "\", vbDirectory)) = vbEmpty Then 'On teste l'existence du répertoire nomdossier
    repert = nomfichier & "\" & nomdossier
    Else
    MkDir nomfichier & "\" & nomdossier 'on le crée s'il n'existe pas
    repert = nomfichier & "\" & nomdossier
End If
ChDir repert....
.....

[nicdodo]

Messieurs merci beaucoup, cela marche tres bien, pour mon erreur de ligne effectivment j'étais loin, mais bon je suis débutant, j'ai passé un long moment à comprendre ton code Mercatog et du coup j'ai appris de nouveaux trucs . En tout cas merci beaucoup à vous 2 c'est super ce que vous faites, je découvre quelque chose qui me plait et grace à vous je peux y mettre un pied dedans et continuer à avancer un projet, c'est tres motivant.