Discussion :

[grisan29]

bonjour a vous tous
Voici mon nouveau classeur de facture/devis résolu dans ce fil rondement mené par BlueMonkey donc mon nouvel ensemble de classeurs devis/facturation permettant de créé des devis/facture et attestation et listé des documents créés selon leur type (devis, facture, paiement)
Cet ensemble est composé :
- D’un classeur devis_facture modele 1.12.xlsm (modification d’un classeur existant <lien vers version précédente>):
o Fichier qui sert de modèle à la création de devis, facture ou attestation.
o Il gère l’ajout plusieurs pages d’articles provenant d’une base articles sur un devis / facture (base fichier externe , vue fractionnée ) :
o Il gère l’ajout d’une référence de client et de chantier depuis une base d’adresse existante (fichier externe)
o A partir d’un document compléter, il est possible de passer du format Devis au format Facture en un clic. (en conservant les informations acticles, infos clients et chantier
o Il permet également de créé une facture d’acompte et d’enregistrer les informations de paiement associé à une facture.
o Ces documents peuvent être visualisés avant impression
o Une fois que le document est complété, il est ajouté dans un fichier externe listant les différents documents créé, et facilement accessible via un lien hypertexte.
o L’ajout dans la base entraine la sauvegarde du fichier dans un format prédéterminé et la création d’un fichier PDF du document.
o Des protections sont présentes sur les fonctions d’ajout dans la base et d’enregistrement de paiement afin d’éviter l’ajout de doublon dans la base de factures et devis
o Un bouton remise à zéro permet de retirer toutes les informations du document, et de suppression de lignes d’articles composant le devis facture (les lignes articles à supprimer doivent être consécutives)
o D’autres fonctions pré-existante n’ont pas été modifiée : Gestion des clients, de la base Article.
Un classeur ListeDevis_Facture.xlsm qui contient :
- Une feuille Devis :
o Contient le prochain n° de devis disponible (pas encore attribué à un document qui a été ajouté dans la base)
o Contient la liste des devis créés, ajouté automatiquement depuis le fichier devis_facture modele 1.12.xlsm
o Pour chaque devis, on retrouve la date de création, les infos sur le client et le montant du devis, et un lien hypertexte vers le document créé.
- Une feuille Facture :
o Contient les prochain n° de facture disponible selon le type de document (facture, acompte, sav)
o Contient la liste des factures créés, ajouté automatiquement depuis le fichier devis_facture modele 1.12.xlsm
o Par chaque facture on retrouve la date de création, des infos clients, le montant de la facture, le reste à payer, une indication si la facture est payé ou non, et un lien hypertexte vers le document créé.
- Une feuille Paiement :
o Contient la liste des différents paiements enregistrés depuis le fichier devis_facture modele 1.12.xlsm
o Pour chaque paiement on garde les infos relatives au client et au mode de paiement, ainsi que le montant payé, et un lien hypertexte vers le document associé

Le classeur base\articles.xlsx (base pré- existante dans la version précédente):
- Contient la liste des articles pouvant être insérés depuis le classeur devis_facture modele 1.12.xls
- Les articles existants rangés par type

Le classeur base\client.xlsx (base pré- existante dans la version précédente) :
- Contient la liste des clients et leur coordonnée pouvant être inséré depuis le classeur devis_facture modele 1.12.xls

Le classeur base\attest et courrier.xls
- Contient un modèle d’attestation 7% pour réduction fiscale destinée au client.
- Le fichier devis_facture modele 1.12.xls complète automatiquement les informations de coordonnée du client et du chantier.

Les sous-dosssiers devis, facture, factureacompte, facture sav (et les versions pdf) sont destinés à recevoir les documents générés automatiquement par le fichier devis_facture modele 1.12.xls lors de l’enregistrement dans la base.

Merci à BlueMonkey pour sa contribution à la réalisation de cet ensemble à partir de ce sujet

[grisan29]

bonjour a vous
me revoilà avec le fichier
bon courage avec et n'hesiter pas a dire en mettant des et aussi en pensant a BlueMonkey qui a mis sa peine pour modifier l'usine a gaz que je faisait

il faut mettre tout le textbox9 en commentaire ou supprimer son code sinon il y a bug a l'ajout d'article car il y a conflit avec le textbox9.change et les lignes

Code :

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

1
2
3
TextBox8 = Me.TextBox5.Text - Me.TextBox9.Text
  If TextBox8 < 0 Then TextBox8 = 0
  TextBox5 = TextBox8

du code ajout sur feuille

Pascal

bonjour a vous tous
derrière le bouton ajouter sur devis/facture dans l'usf "bibliothèques" rajouter les lignes qui se trouve après

Code :

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

1
2
Application.ScreenUpdating = False
  Application.EnableEvents = False

en fait comme ceci

Code :

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

1
2
3
4
5
6
7
 Application.ScreenUpdating = False
  Application.EnableEvents = False
 
  If Me.TextBox9.Value = "" Then
  MsgBox "Entrer une quantité,svp"
  Exit Sub
  End If

afin d'avoir un message qui demande d'entrer une quantité car il y a des risque d'oubli dans la rapidité d'exécution

la version du fichier envoyer fonctionne pour 2007 ou plus et utilise une listview que tout le monde n'a pas d'installer donc commencer par installer mscombct2 que vous trouverez dans cette discussion et qui j’espère vous aidera à avoir la listview

revoici le classeur devis/facturation

et n'oubliez pas de dire en pensant a BlueMonkey a toi qui a mis ta peine pour le remanier et en cliquant sur

Pascal

[grisan29]

bonjour a vous tous

je me suis aperçu qu'il y a un léger problème lors de l'impression, car a l'aperçu on remarque que le format a légèrement changer comme si la feuille s'était élargie au niveau des articles?????

Pascal

[grisan29]

bonjour a vous tous
excuser moi du retard a donner la modification mais j'avais oublier de le faire tout simplement, code de l'aperçu a remplacer par celui ci dessous

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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
Private Sub Aperçu_Click()
        'Sub Imprimer_Commande()
        Dim Nb As Integer, X As Long, DerLig As Long
        Dim No As Variant, Sh As Worksheet, T(), A As Integer
        Dim K As Integer, Hb As HPageBreak
        liste_boutons.Hide
        'Il faut faire attention avec cette commande "Application.ScreenUpdating = False"
        'Car elle perturbe le travail de Sh.HPageBreaks et cela fait planter la procédure.
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Set Sh = Worksheets(WS_FACTURE)
 
        With Sh
            .Activate
            '.Range("C:C").EntireRow.Hidden = False
            MasqueLignesEnteteVide False
            'Déterminer la dernière ligne de la feuille
            DerLig = .Cells.Find("*", LookIn:=xlValues, _
                    SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
 
            'Déterminer la hauteur des marges du haut et
            'du bas de la fenêtre
            With .PageSetup
                .LeftMargin = Application.CentimetersToPoints(1.5)
                .RightMargin = Application.CentimetersToPoints(1.5)
                .TopMargin = Application.CentimetersToPoints(2.5)
                .BottomMargin = Application.CentimetersToPoints(2.5)
                .HeaderMargin = Application.CentimetersToPoints(1)
                .FooterMargin = Application.CentimetersToPoints(1)
                .CenterHorizontally = True
                .CenterVertically = False
            End With
 
            Application.ScreenUpdating = True
            DoEvents
            'Afficher les sauts de page
            .DisplayPageBreaks = True
            'Nécessaire pour le hpagebreaks
            Application.GoTo .Range("C" & DerLig)
 
            'Déterminer la dernière ligne pour chaque saut horizontal
            'et les placer dans une variable tableau (T)
            If .HPageBreaks.Count > 0 Then
                For Each Hb In .HPageBreaks
                    K = K + 1
                    ReDim Preserve T(1 To K)
                    T(K) = Hb.Location.Row - 1
                Next
            End If
 
            'Détermine le nombre de pages à imprimer
            If K = 0 Then
                Nb = 1
            ElseIf DerLig > T(K) Then
                Nb = UBound(T) + 1
            ElseIf DerLig = T(K) Then
                Nb = UBound(T)
            Else
                If DerLig > 11 Then
                    Nb = 1
                Else
                    Application.ScreenUpdating = True
                    Application.EnableEvents = True
                    MsgBox "Aucune donnée dans le tableau." & vbCrLf & _
                        "L'impression est annulée.", vbCrLf & _
                        vbCrLf & vbInformation + vbOKOnly, "Attention"
                    Exit Sub
                End If
            End If
 
            X = MsgBox("Vous allez lancer une impression de " & Nb & " page(s)." & vbCrLf & vbCrLf & _
                    "Désirez-vous affectuer une prévisualisation du document qui " & _
                    "sera imprimé?", vbYesNoCancel + vbInformation, "Attention")
 
            'Annulation de l'impression
            If X = vbCancel Then
                .DisplayPageBreaks = False
                Application.EnableEvents = True
                Application.GoTo .Range("C1"), True
                Application.ScreenUpdating = True
                Exit Sub
            End If
 
            Application.ScreenUpdating = True
            DoEvents
 
            With .PageSetup
            .PrintArea = "C1:M" & DerLig  'Sh.UsedRange.Rows.Count
                 '.PrintArea = ""
                 'la plage de cellules à imprimer pour chaque page
                 .PrintTitleRows = Sh.Range("C17:M18").Address
                 '.FitToPagesTall = 1
                 .FitToPagesWide = 1
                 .Orientation = xlPortrait
                 .PrintHeadings = False
                 '.CenterHeader = "&14&""Arial,Gras""FACTURE SAV N° " & No & _
                             "pied de page au centre"
                 '.CenterFooter = "&14&""SIRET : 000000000   -   NAF : 00000   -   RCS : 00000 -   N° TVA   :  FR00000000000" & Chr(10) & _
                                                     "assurance décennale n°000000000 de chez untel"
           'centerHeader et centerFooter sont mis dans la mise en page
            End With
 
            DessineBordureDeFinDePage True
 
            If X = vbYes Then
                .PrintPreview
            Else
                '.PrintOut 'à Activer après tes tests
            End If
 
            DessineBordureDeFinDePage False
        End With
 
        With Sh
            '.Range("C:C").EntireRow.Hidden = False
            .DisplayPageBreaks = False
            Application.GoTo .Range("A1"), True
        End With
        MasqueLignesEnteteVide True
 
        Application.ScreenUpdating = True
        ActiveWindow.View = xlNormalView
        With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 0
        End With
        Application.EnableEvents = True
        liste_boutons.Show
    End Sub

et ci dessous le code a mettre derrière un bouton sur l'usf "bibliothèque"
afin d'intégrer des variantes dans le devis ce qui est parfois utile

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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
Private Sub Variante_Click()
'*** bouton "ajout variante sur devis/facture"
 
  Dim lig As Integer, i As Integer
  Dim Sh As Worksheet, VPB As PageSetup
  Dim LargeurCol As Single, MaHauteur As Single, Lg_Origine As Single
  'calcul de la valeur de la variable lig
  Dim mot As String
  Dim ctrMt, ctrTVA7, ctrTVA19 As Variant
 
  Application.ScreenUpdating = False
  Application.EnableEvents = False
 
  With wsFacture
    .Range("c18:M18,O18:P18").Borders(xlEdgeBottom).LineStyle = xlContinuous
    lig = .Range("B65536").End(xlUp)(2).Row
    If lig < 19 Then lig = 19
 
    'insertion d'une ligne
    '.Rows(lig + 1).Insert
    .Range("C" & lig - 1 & ":P" & lig - 1).Copy
    .Range("C" & lig).Insert xlShiftDown
    .Range("C" & lig & ":P" & lig).ClearContents
    .Range("C" & lig & ":H" & lig).HorizontalAlignment = xlLeft
 
    If Not Me.TextBox14 = "" Then
      .Rows(lig) = ""
      .Range("D" & lig) = TextBox14.Value
      Lg_Origine = .Columns(3).ColumnWidth
      LargeurCol = .Columns(3).ColumnWidth + .Columns(4).ColumnWidth + .Columns(5).ColumnWidth + .Columns(6).ColumnWidth + _
                   .Columns(7).ColumnWidth + .Columns(8).ColumnWidth
      .Columns(4).ColumnWidth = LargeurCol
      With .Range("D" & lig, "G" & lig)
        .Font.Size = 14
        .Font.Name = "arial"
        .MergeCells = False
        .WrapText = True  'retour du texte à la ligne
        .EntireRow.AutoFit  'mettre la ligne en ajustement auto de la hauteur
        MaHauteur = .RowHeight  'voir quelle est la hauteur de la ligne une fois cet autofit fait
        .MergeCells = True  'refusionner
 
        .VerticalAlignment = xlCenter
        .RowHeight = IIf(MaHauteur > 15, MaHauteur, 15)  'si la hauteur une fois autofit fait est inferieur à 15 je laisse 15 en minimum sinon hauteur de l'autofit (perso c'est la hauteur mini que je voulais
      End With
    End If
    .Columns(4).ColumnWidth = Lg_Origine
    'recopie et mise en forme des données dans la feuille facturation
    .Cells(lig, "B") = Me.TextBox13
    .Cells(lig, "D") = Me.TextBox14
    .Cells(lig, "D").Font.Bold = False
    .Cells(lig, "D").HorizontalAlignment = xlLeft
    .Cells(lig, "D").VerticalAlignment = xlCenter
    .Range("D" & lig & ":G" & lig).Merge
 
 
    .Cells(lig, "H").Value = CDbl(TextBox15) + (CDbl(TextBox15) * IIf(OptionButton1, 0.07, 0.196))
    .Cells(lig, "H").NumberFormat = "#,##0.00€"
 
    .Cells(lig, "M") = Abs(Me.OptionButton2) + 1
 
 
    'calcul du montant HT
    If IsNumeric(.Cells(lig, "I")) Then 'And IsNumeric(.Cells(lig, "K"))
      .Cells(lig, "O").FormulaR1C1 = "=IF(RC[-2]=1,RC[-6]*RC[-4]*0.07,"""")"
      .Cells(lig, "O").NumberFormat = "#,##0.00€"
      .Cells(lig, "P").FormulaR1C1 = "=IF(RC[-3]=2,RC[-7]*RC[-5]*0.196,"""")"
      .Cells(lig, "P").NumberFormat = "#,##0.00€"
 
 
 
 
 
 
    End If
    'calcul du montant HT
    If IsNumeric(.Cells(lig, "I")) Then ' And IsNumeric(.Cells(lig, "K")) Then
        .Cells(lig, "L") = "" '"=" & .Cells(lig, "I").AddressLocal & "*" & .Cells(lig, "K").AddressLocal
    Else
      .Cells(lig, "O") = ""
      .Cells(lig, "P") = ""
    End If
    'calcul des totaux montant HT, TVA5,5, TVA 19,6
    For i = lig To 1 Step -1
        If .Cells(i, "K") = "REPORT" Or .Cells(i, "K") = "Quantité" Then Exit For
    Next i
    .Cells(lig + 1, "L").Formula = "=SUM(" & .Range(.Cells(i + 1, "L"), .Cells(lig, "L")).AddressLocal & ")"
    .Cells(lig + 1, "L").NumberFormat = "#,##0.00€"
    .Cells(lig + 1, "O").Formula = "=SUM(" & .Range(.Cells(i + 1, "O"), .Cells(lig, "O")).AddressLocal & ")"
    .Cells(lig + 1, "O").NumberFormat = "#,##0.00€"
    .Cells(lig + 1, "P").Formula = "=SUM(" & .Range(.Cells(i + 1, "P"), .Cells(lig, "P")).AddressLocal & ")"
    .Cells(lig + 1, "P").NumberFormat = "#,##0.00€"
 
    If .Cells(lig + 1, "P") < 0.0001 Then .Cells(lig + 1, "P") = ""
    If .Cells(lig + 1, "O") < 0.0001 Then .Cells(lig + 1, "O") = ""
 
    'Remise a zéro du formulaire
    ' TextBox1.Value = ""
    'TextBox2.Value = ""
    'Me.TextBox7 = ""
    ' TextBox3.Value = ""
    'TextBox9.Value = ""
    'TextBox5.Value = ""
    'TextBox8.Value = ""
    'TextBox4.Value = ""
    'OptionButton3.Value = False
 
    'Formatage du tableau
 
 
    .Cells(lig, "C").Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Range(.Cells(lig, "I"), .Cells(lig, "P")).Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Range(.Cells(lig, "C"), .Cells(lig, "M")).Borders(xlEdgeTop).LineStyle = xlNone
    .Range(.Cells(lig, "O"), .Cells(lig, "P")).Borders(xlEdgeTop).LineStyle = xlNone
    .Range(.Cells(lig, "C"), .Cells(lig, "M")).Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Range(.Cells(lig, "O"), .Cells(lig, "P")).Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Range(.Cells(lig, "D"), .Cells(lig, "H")).Borders(xlInsideVertical).LineStyle = xlNone
    .Range(.Cells(lig, "I"), .Cells(lig, "Q")).Borders(xlInsideVertical).LineStyle = xlContinuous
    .Range(.Cells(lig, "O"), .Cells(lig, "P")).VerticalAlignment = xlCenter
 
    .Range(.Cells(lig, "I"), .Cells(lig, "M")).VerticalAlignment = xlCenter
 
    With .Range("C19:M" & lig & ",O19:P" & lig)
      .Font.Size = 14
      .Font.Name = "arial"
    End With
  End With
  wsFacture.Range("c19:M19").Borders(xlEdgeTop).LineStyle = xlContinuous
  wsFacture.Range("O19:P19").Borders(xlEdgeTop).LineStyle = xlContinuous
 
  ActiveWindow.ScrollRow = IIf((lig - NB_LIGNE_ARTICLE_FIGE) > Range("DOC_TITRE").Row, lig - NB_LIGNE_ARTICLE_FIGE, Range("DOC_TITRE").Row + 1)
 
  'TextBox8 = Me.TextBox5.Text - Me.TextBox9.Text
  'If TextBox8 < 0 Then TextBox8 = 0
  'TextBox5 = TextBox8
 
 
  Application.ScreenUpdating = True
  Application.EnableEvents = True
 
End Sub

Pascal

[grisan29]

bonjour a vous tous
je viens pour ajouter le code de gestion des sous-total qui fonctionne en cliquant sur la tranche concernée
ce code est a mettre derrière un bouton sur la feuille où sur un usf

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
Private Sub soustot_Click()
Set ws = ActiveSheet
'lf numéro de dernière ligne pour la formule sous-total
lf = ActiveCell.Row
' on vérifie que la cellule sélectionnée est bien un entête de rubrique
If ActiveCell.Column <> 3 Or ActiveCell = "" Then
MsgBox "vous devez selectionner la rubrique pour laquelle vous voulez un sous-total"
Exit Sub
End If
' fl numéro de première ligne pour la formule sous-total
fl = 0
' on empêche les events
Application.EnableEvents = False
' on mémorise le paramétrage pour le calcul
calculationparam = Application.Calculation
' on met le paramétrage du calcul en manuel
Application.Calculation = xlCalculationManual
' soustotalencours variable de controle de la boucle
soustotalencours = True
' tant qu'on a pas terminé l'exercice de sous-total
While soustotalencours
If fl = 0 And ws.Cells(lf, 3) <> "" Then
'ligne rubrique trouvée
fl = lf
ElseIf fl <> 0 And (ws.Cells(lf, 4) = "" Or ws.Cells(lf, 3) <> "") Then
'ligne blanche ou ligne nouvelle rubrique trouvée après le détail d'une rubrique
If Left(ws.Cells(lf, 7), 4) <> "sous" Then
'il n'y a pas encore de ligne sous-total, on insère une nouvelle ligne
ws.Rows(lf).Insert Shift:=xlDown
End If
' on inscrit sous-total, suivi de la rubrique, suivi de ":"
ws.Cells(lf, 7) = "sous total : " & ws.Cells(fl, 3) & " : "
' on fait le cadrage à droite
ws.Cells(lf, 7).HorizontalAlignment = xlRight
ws.Cells(lf, 7).Font.Underline = xlUnderlineStyleSingle
'ws.Cells(lf, 7).Font.Bold = True
ws.Cells(lf, 7).WrapText = False
' on adapte le format pour la somme
ws.Cells(lf, 8).NumberFormat = "0.00€"
' on insère la formule =sum( fl,lf-1)
fs = "=sum(" & ws.Cells(fl, 12).Address & ":" & ws.Cells(lf - 1, 12).Address & ")"
ws.Cells(lf, 8).Formula = fs
soustotalencours = False
fl = 0
End If
lf = lf + 1
Wend
Application.EnableEvents = True
Application.Calculation = calculationparam
End Sub

par ailleurs j'ai remarqué que lors de la remonter où la descente d'une ligne sur la feuille les formules étaient effacées (fâcheux n'est ce pas ) donc voici la modification

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
83
Private Sub Remonter_Ligne()
              Dim T(), NoLigne As Long, S As Double, H As Double
              Dim DerLig As Long, Ok As Boolean, ActLigne As Long
 
              'Feuil1 est le nom de la propriété de l'objet "Feuille" visible
              'dans la fenêtre de l'éditeur de code et non le nom de l'onglet
              'de la feuille.
              'With Feuil1
              With Worksheets("facture")
                'Trouve la dernière ligne occupée dans les colonnes c:h
                DerLig = .Range("C:H").Find(What:="*", _
                                            LookIn:=xlFormulas, _
                                            SearchOrder:=xlByRows, _
                                            SearchDirection:=xlPrevious).Row
                'Si ton tableau était vide, la dernière ligne serait
                'la première ligne de ton tableau.
                If DerLig < 19 Then DerLig = 19
              End With
 
              'Si l'usager a sélectionné une cellule dans la plage C19:Cx
              If Not Intersect(ActiveCell, Range("C19:H" & DerLig)) Is Nothing Then
                'Une variable pour le numéro de ligne
                NoLigne = ActiveCell.Row
                'Si la ligne sélectionnées est en caractère grand et fusionnée
                If Range("C" & NoLigne).MergeCells = True And Range("C" & NoLigne).Font.Bold = True Then
                  'On remonte d'une ligne
                  ActiveCell.offset(-1).Select
                  'On met fin à l'opération
                  Exit Sub
                End If
                'si la ligne active est 19, fin des opérations
                'car on ne peut pas remonter plus haut
                If ActiveCell.Row = 19 Then Exit Sub
                'une petite boucle afin de trouver la ligne aus-dessus de la ligne
                'Active qui ne soit pas fusionnée et en caractère gras.
                Do
                  NoLigne = NoLigne - 1
                  If Range("C" & NoLigne).MergeCells <> True Then 'And _Range("C" & NoLigne).Font.Bold <> True Then
                    'Si le critère est respecter, sortie de la boucle
                    Ok = True
                    Exit Do
                  End If
                Loop Until NoLigne = 19
                'Une deuxième variable pour le numéro de la ligne de la cellule active.
                ActLigne = ActiveCell.Row
                'Au sortir de la boucle, si tout est Ok
                If Ok = True Then
                  'met dans une variable tableau, le contenu de la ligne
                  T = Rows(NoLigne).Cells.Value
                  'met dans S la hauteur de la ligne active
                  S = Rows(ActLigne).Height
                  'met en H la hauteur de la ligne où sera copiée les données
                  H = Rows(NoLigne).Height
                  'Copie de la ligne active vers la ligne au-dessus
                   Rows(NoLigne).Value = Rows(ActLigne).Value
 
                  'Mise à jour des formules ligne NoLigne
                  Range("L" & NoLigne).Formula = "=$I" & NoLigne & "*$K" & NoLigne
                  'partie en dessous bon mais pas encore fonctionnelle (je cherche pourquoi)
                  Range("o" & NoLigne).Select
                  ActiveCell.FormulaR1C1 = "=IF(RC[-2]=1,RC[-6]*RC[-4]*0.07,"""")"
                  Range("P" & NoLigne).Select
                  ActiveCell.FormulaR1C1 = "=IF(RC[-2]=1,RC[-7]*RC[-5]*0.196,"""")"
 
                  'Copie des valeurs de T dans la ligne active
                  Rows(ActLigne) = T
                  'Nouvelle hauteur de la ligne de la ligne active s'il y a lieu
                  Rows(ActLigne).RowHeight = H
                  'Nouvelle hauteur de la ligne de la ligne au-dessus s'il y a lieu.
                  Rows(NoLigne).RowHeight = S
 
 
                 'Mise à jour des formules ligne ActLigne
                  Range("L" & ActLigne).Formula = "=$I" & ActLigne & "*$K" & ActLigne
                  Range("o" & ActLigne).Select
                  ActiveCell.FormulaR1C1 = "=IF(RC[-2]=1,RC[-6]*RC[-4]*0.07,"""")"
                  Range("P" & ActLigne).Select
                  ActiveCell.FormulaR1C1 = "=IF(RC[-2]=1,RC[-7]*RC[-5]*0.196,"""")"
                'sélection de la ligne où ont été copiées les données
                  Rows(NoLigne).Cells(1, 4).Select
                End If
              End If
            End Sub

et

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
83
Private Sub Descendre_Ligne()
   Dim T(), NoLigne As Long, S As Double, H As Double
      Dim DerLig As Long, Ok As Boolean, ActLigne As Long
 
      'Feuil1 est le nom de la propriété de l'objet "Feuille" visible
      'dans la fenêtre de l'éditeur de code et non le nom de l'onglet
      'de la feuille.
      'With Feuil1
      With Worksheets("facture")
        'Trouve la dernière ligne occupée dans les colonnes c:h
        DerLig = .Range("C:H").Find(What:="*", _
                                    LookIn:=xlFormulas, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlPrevious).Row
        'Si ton tableau était vide, la dernière ligne serait
        'la première ligne de ton tableau.
        If DerLig < 19 Then DerLig = 19
      End With
 
      'Si l'usager a sélectionné une cellule dans la plage C19:Cx
      If Not Intersect(ActiveCell, Range("C19:H" & DerLig)) Is Nothing Then
        'Une variable pour le numéro de ligne
        NoLigne = ActiveCell.Row
        'Si la ligne sélectionnées est en caractère grand et fusionnée
        If Range("C" & NoLigne).MergeCells = True And Range("C" & NoLigne).Font.Bold = True Then
          'On remonte d'une ligne
          ActiveCell.offset(1).Select
          'On met fin à l'opération
          Exit Sub
        End If
        'si la ligne active est 19, fin des opérations
        'car on ne peut pas remonter plus haut
        If ActiveCell.Row = 19 Then Exit Sub
        'une petite boucle afin de trouver la ligne aus-dessus de la ligne
        'Active qui ne soit pas fusionnée et en caractère gras.
        Do
          NoLigne = NoLigne + 1
          If Range("C" & NoLigne).MergeCells <> True Then 'And _Range("C" & NoLigne).Font.Bold <> True Then
            'Si le critère est respecter, sortie de la boucle
            Ok = True
            Exit Do
          End If
        Loop Until NoLigne = 19
                'Une deuxième variable pour le numéro de la ligne de la cellule active.
                ActLigne = ActiveCell.Row
                'Au sortir de la boucle, si tout est Ok
                If Ok = True Then
                  'met dans une variable tableau, le contenu de la ligne
                  T = Rows(NoLigne).Cells.Value
                  'met dans S la hauteur de la ligne active
                  S = Rows(ActLigne).Height
                  'met en H la hauteur de la ligne où sera copiée les données
                  H = Rows(NoLigne).Height
                  'Copie de la ligne active vers la ligne au-dessus
                   Rows(NoLigne).Value = Rows(ActLigne).Value
 
                  'Mise à jour des formules ligne NoLigne
                  Range("L" & NoLigne).Formula = "=$I" & NoLigne & "*$K" & NoLigne
                  'partie en dessous bon mais pas encore fonctionnelle (je cherche pourquoi)
                  Range("o" & NoLigne).Select
                  ActiveCell.FormulaR1C1 = "=IF(RC[-2]=1,RC[-6]*RC[-4]*0.07,"""")"
                  Range("P" & NoLigne).Select
                  ActiveCell.FormulaR1C1 = "=IF(RC[-2]=1,RC[-7]*RC[-5]*0.196,"""")"
 
                  'Copie des valeurs de T dans la ligne active
                  Rows(ActLigne) = T
                  'Nouvelle hauteur de la ligne de la ligne active s'il y a lieu
                  Rows(ActLigne).RowHeight = H
                  'Nouvelle hauteur de la ligne de la ligne au-dessus s'il y a lieu.
                  Rows(NoLigne).RowHeight = S
 
 
                 'Mise à jour des formules ligne ActLigne
                  Range("L" & ActLigne).Formula = "=$I" & ActLigne & "*$K" & ActLigne
                  Range("o" & ActLigne).Select
                  ActiveCell.FormulaR1C1 = "=IF(RC[-2]=1,RC[-6]*RC[-4]*0.07,"""")"
                  Range("P" & ActLigne).Select
                  ActiveCell.FormulaR1C1 = "=IF(RC[-2]=1,RC[-7]*RC[-5]*0.196,"""")"
                'sélection de la ligne où ont été copiées les données
                  Rows(NoLigne).Cells(1, 4).Select
                End If
              End If
End Sub

voila ce que je peux vous dire pour aujourdhui, mais si vous avez une remarque n'hésiter pas

Pascal

[grisan29]

bonjour a tous

en fait les codes sont bons, mais pour contrer le bug j'ai mis un autre usf pour déplacer une ligne dans la partie comprise sous la "tranche" concernée par le déplacement en fait
il faut de se positionner sur la cellule de la ligne à déplacer
ensuite appuyer sur le bouton déplacement(a créer sur feuille)
faire un choix dans la combobox puis valider sur le bouton
il s'agit d'intégrer un usf (nommé "Tranche") de taille (voir propriétés)

height 100.5 et width 526,50

et d'y intégré
-2 combobox dans une "frame" chacun
1-la 1ére se nomme combobox1 et est de longueur width 348
2- la 2ème se nomme Cb_ligne et est de longueur width 120, mais a sa propriété

"showDropButtonWend" à never

-1 Bouton de la longueur des 2 combobox, à propritété "enabled" à "false
puis voici le code a insérer

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
Dim c As Range
Dim montab(10)
 
Private Sub ComboBox1_Change()
Cb_ligne.Text = montab(ComboBox1.ListIndex + 1)
If ComboBox1.Text <> "" Then
CommandButton1.Enabled = True
Else:
CommandButton1.Enabled = False
End If
End Sub
 
Private Sub CommandButton1_Click()
Dim r As Integer
r = ActiveCell.Row
   Rows(r & ":" & r).Select
   Selection.Copy ': Exit Sub
    Rows(Cb_ligne.Text + 1 & ":" & Cb_ligne.Text + 1).Select
 
    Selection.Insert Shift:=xlDown
    If r < Cb_ligne.Text Then
    Rows(r & ":" & r).Select
    Else
    Rows(r + 1 & ":" & r + 1).Select
    End If
 
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
Call mise_a_jour_cb
End Sub
 
Private Sub UserForm_Initialize()
Call mise_a_jour_cb
End Sub
Sub mise_a_jour_cb()
ComboBox1.Clear
 
With Worksheets("facture")
                'Trouve la dernière ligne occupée dans les colonnes c:h
                DerLig = .Range("C:H").Find(What:="*", _
                                            LookIn:=xlFormulas, _
                                            SearchOrder:=xlByRows, _
                                            SearchDirection:=xlPrevious).Row
                'Si ton tableau était vide, la dernière ligne serait
                'la première ligne de ton tableau.
                If DerLig < 19 Then DerLig = 19
 
For Each c In .Range("C19:C" & DerLig)
If c.Font.Bold = True And c.Font.Underline <> xlUnderlineStyleSingle Then
If c.Text <> "" Then ComboBox1.AddItem c: montab(ComboBox1.ListCount) = c.Row
End If
Next
End With
End Sub

voici une représentation de l'usf dans l'aperçu joint

ensuite les boutons de remonter/descente peuvent fonctionner entre la tranche sélectionné et celle qui suit , mais s'il n'y a pas de sous-total d'inscrit les codes de remonter/descente fonctionne bien

mais voici une amélioration du code sous total
mais il faut enlever

private devant sub du code du bouton remonter ligne

dans les macros

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
Private Sub soustot_Click()
        Dim plage As String
        plage = Selection.Address
        Dim d As Integer
        Dim r As Integer
        Dim l As Integer
        On Error GoTo fin:
        'pour autant que l'on reste sur deux chiffres pour les lignes sélectionnés
        l = (Len(plage) - InStr(8, plage, "$"))
        r = Right(plage, l)
        d = CInt(Mid$(plage, 4, 2))
 
        Set ws = ActiveSheet
        'lf numéro de dernière ligne pour la formule sous-total
        lf = ActiveCell.Row
        ' on vérifie que la cellule sélectionnée est bien un entête de rubrique
        If ActiveCell.Column <> 3 Or ActiveCell = "" Then
        MsgBox "vous devez selectionner la rubrique pour laquelle vous voulez un sous-total"
        Exit Sub
        End If
        ' on empêche les events
        Application.EnableEvents = False
        ' on mémorise le paramétrage pour le calcul
        calculationparam = Application.Calculation
        ' on met le paramétrage du calcul en manuel
        Application.Calculation = xlCalculationManual
        'il n'y a pas encore de ligne sous-total, on insère une nouvelle ligne
        If ws.Cells(r + 3, 3).Text = "'Arrêté le présent devis à la somme de : " Then
        ws.Rows(r + 1).Insert Shift:=xlDown
        Else:
        ws.Rows(r).Insert Shift:=xlDown
        Cells(r + 1, 3).Select
 
        Call Remonter_Ligne 
        Range("D" & r & ":H" & r).Select
        Selection.MergeCells = True
        ws.Range("l" & r + 1) = ""
        End If
        'End If
         Dim st As String
        st = "sous total : " & ws.Cells(d, 3) & " : "
        ws.Cells(r + 1, 7).UnMerge
        ws.Cells(r + 1, 7).Value = st '"sous total : " & ws.Cells(d, 3) & " : "
        ' on fait le cadrage à droite
        ws.Cells(r + 1, 7).HorizontalAlignment = xlRight
        ws.Cells(r + 1, 7).Font.Underline = xlUnderlineStyleSingle
        ws.Cells(r, 7).Font.Bold = True
        ws.Cells(r + 1, 7).WrapText = False
        ' on insère la formule =sum( fl,lf-1)
        fs = "=sum(" & ws.Cells(d, 12).Address & ":" & ws.Cells(r - 1, 12).Address & ")"
        ws.Cells(r + 1, 8).Formula = fs
 
        fl = 0
fin:
        Application.EnableEvents = True
        Application.Calculation = calculationparam
        End Sub

bon je pense que maintenant c'est parfait, il me reste a vous souhaiter de bonnes fêtes de fin d'années et joyeux Noël puis que la nouvelle année soit bénéfique a vous tous
et Merci BlueMonkey MERCI, MERCI

Pascal

[grisan29]

bonjour a vous tous

concernant la création d'une facture d'acompte, je trouvais la feuille nue dessous la ligne d'acompte, alors j'ai chercher la raison et ai trouvé que BlueMonkey a prévu de cacher les lignes qui font le bas de page a ce moment là, donc pour le pas influer sur la fonction du classeur , j'ai modifier le code "AjouteAccompteSurFacture" pour avoir un bas de page dans le module Mgestion par ceci

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
Public Sub AjouteAccompteSurFacture(montant As Double)
    With Sheets(WS_FACTURE)
        .Range("acom") = "ACOMPTE VERSE "
        With .Range("acom").offset(, 1)
          .NumberFormat = "#,##0.00 [$€-1]"
          .Value = .Value + montant
         With .Font
              .Size = 14
              .Name = "Arial"
          End With
        End With
        '.Range("MTTC2").Value = .Range("MTTC")
 
 
    .Range("F74:G75").Borders.Weight = xlThin
    .Range("G74").FormulaR1C1 = "=OFFSET(R[-0]C[-1],-4,10)"
    .Range("G75").FormulaR1C1 = "=OFFSET(R[-1]C[-1],-5,9)"
    With .Range("L76")
      .FormulaR1C1 = "=OFFSET(R[-1]C,-6,0)"
      .NumberFormat = "#,##0.00 €"
      .Name = "MTTC"
    End With
    With .Range("E77")
      .Value = "mode de paiement"
      .HorizontalAlignment = xlRight
      .Font.Bold = True
    End With
    .Range("F77").Value = "par chèque "
    .Range("F74").Value = "TVA2 = 20%"
    .Range("F75").Value = "TVA1 = 10%"
    With .Range("J76:K76")
      .Font.Bold = True
      .Merge True
      .HorizontalAlignment = xlRight
    End With
    .Range("J76").Value = "ACOMPTE RECU"
    .Range("C72").Value = "Arrêtée la présente facture à la somme de : "
    .Range("C73").Formula = "=chiffrelettre(MTTC)"
    'Application.Calculate
   With .Range("F74:G75,J76:L76,E77:F77,C72:C73").Font
      .Size = 14
      .Name = "Arial"
    End With
  'End With
 
End With
End Sub

voila pour la feuille acompte que je trouvais vide a envoyer au client

Pascal

[grisan29]

bonjour a tous

voici une autre option pour ce classeur devis facturation que BlueMonkey a merveilleusement bien modifié
donc j'ai créer un usf de gestion commande aux fournisseurs dès la réception de l'accord du devis
pour cela sous C:\facturation-test\ où un autre chemin a votre goût , j'ai créer un dossier avec des sous dossiers(feuilles xlsx)au nom de mes fournisseurs
puis un usf avec listview a checbox qui se charge de récolter les lignes du devis, il y a une combobox qui affiche le nom des fournisseurs, puis un bouton pour le transfert dans les feuilles concernées mais les coches dans la listview sont vidées a chaque clic sur la combobox pour ne pas envoyer inutilement des articles à un fournisseur non concerné
c'est pas tout d'expliquer mais le classeur va etre joint et peut etre intégrer facilement au fichier originel
comme l'envoi de fichier sous .xlsm ne se fait pas il est sous .xls

[grisan29]

Bonjour a vous tous

je viens après toutes les modifications que j'ai mis sur le post depuis le début vous donner le classeur avec toutes les modifications installées,pour les variantes il faut d'abord passer par une tranche puis après ajouter les articles par le boutons "variantes"
le classeur est a installer sous c:/
Pièce jointe 140819

bon courage avec et n'hésiter pas a me demander plus en pensant a BlueMonkey qui mis tout son savoir pour modifier mon fichier

Pascal

[aaltruiste]

bonsoir à tous
je suis un nouveau venu et suis intéressée par ce fil car je suis en train de créer mon entreprise de plomberie chauffage.
je suis curieux de voir ce que votre travail donne mais après chargement je ne peux pas utiliser ce classeur:erreur de compilation: projet ou bibliothèque introuvable.
auriez-vous une solution?
merci

[grisan29]

Bonsoir aaltruist
quelle version d'excel et windows utiliser vous , l'avez installer sous c: et dans les références vba avez la listview de cochée?si non reporter vous au post du 31/07/2013, 19h30 ou j'ai mis un lien pour intaller la listview

Pascal

[aaltruiste]

merci de votre réponse
j'utilise windows 7 avec office 2010
quand vous dites: "installer vers c:" votre dossier ne contient pas de fichier install, il est en zip
je ne comprends pas
et la listview alors là aucune idée de ce que ça peut être
j'ai l'air c.. avec tout ça!!

[grisan29]

bonjour aaltruist

installer sous c: veux dire une fois décompresser déplacer le dossier sous c:
pas d'office 64bits j'espère

concernant la listview c'est ce que je t'ai mis comme lien au dessus,
essaye de créer une listview sur un classeur vierge (neuf)

tu accédes a vba par alt+f11 la tu mets un userform et tu a un boite à outils qui apparait voir vue ci dessous

Pièce jointe 138172

le contrôle listview est le bouton avec 5 ronds 3 en haut et 2 en bas et souligné et le contrôle est sur l'userform

retourner en haut du post du 31/07/2013, 19h30 pour voir les liens que mis pour installer la listview

reviens après avoir visionner les liens

Pascal

[grisan29]

bonjour a tous

suite a la nouvelle législation sur la tva applicable depuis le 1er janvier, j'ai du modifier l'usf mise en page en rajoutant un bouton "autoliquidation" afin de pouvoir faire une facture sans tva a un donneur d'ordre
Donc j'ai fini par créer un nouveau bouton afin de ne pas créer d'optionbutton supplémentaire qui désorganisait les autres optionbutton, mais il a fallu que je renomme des cellules
dont voici le code

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
Private Sub Clic_si_autoliqui_Click()
Call autoliquidation
End Sub
Sub autoliquidation()
'
 
AfficheMaqueZonesPourTyp DOC_FACT
 
  With Sheets(WS_FACTURE)
    .Range("reste").Value = ""
    .Range("MTTC2").Value = ""
    .Range("valtva2").Value = ""
    .Range("dont").Value = ""
    .Range("tva").Value = ""
    .Range("moi").Value = ""
    .Range("cli").Value = ""
    .Range("accord").Value = ""
    .Range("comme").Value = ""
    .Range("acompte").Value = ""
    .Range("suivant").Value = ""
    .Range("surdev").Value = ""
    .Range("paie").Value = "par virement "
    .Range("chiflet").Font.ColorIndex = xlAutomatic
    .Range("modpaie").Value = "mode de paiement "
    .Range("arret").Value = "Arrêtée la présente facture à la somme de : "
    .Range("recep").Value = "6 jours à réception de la facture "
    .Range("datfac").Value = "date de paiement "
    .Range("reste").Value = "RESTE A PAYER "
    .Range("reste").Font.Bold = True
    .Range("reste:MTTC2").Borders(xlEdgeTop).LineStyle = xlContinuous
    [MTTC2] = [MTTC]
    .Range("dont").Value = "dont "
    .Range("tva").Value = "de tva "
    .Range("valtva2").Value = [TVAG]
    .Range("D1").Value = "FACTURE"
    .Range("acom").Value = "Acompte versé"
    .Range("acompte").Value = ""
 
    .Range("ligne20:totaltva19").Merge True
    .Range("ligne10:totaltva7").Value = ""
    .Range("M19:M650").ClearContents
    .Range("tvaglo").Value = "Pas de TVA"
    .Range("TVAG").ClearContents
    .Range("ligne20:totaltva19").FormulaR1C1 = "AUTOLIQUIDATION"
    .Range("ligne20:totaltva19").Borders.LineStyle = 1
    .Range("ligne10:totaltva7").Borders.LineStyle = 0
    .Range("autoliqui").FormulaR1C1 = _
        "en application du Décret n°2013-346 du 24 avril 2013 - art. 2"
    .Hyperlinks.Add .Range("autoliqui"), "http://www.legifrance.gouv.fr/affichTexteArticle.do;jsessionid=7A3BE893290F4F96C24552B608464CD4.tpdjo15v_2?cidTexte=JORFTEXT000027351702&idArticle=LEGIARTI000027353142&dateTexte=20140316&categorieLien=id#LEGIARTI000027353142"
    With .Range("autoliqui").Font
        .Name = "Arial"
        .Size = 16
        .Bold = True
    End With
  End With
  Call acom
UpdateTitre DOC_FACT
End Sub

et aussi un autre code pour remettre bien le bas de page

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
Sub remettva()
 
With Sheets("facture")
    With .Range("ligne20:totaltva19")
        .UnMerge
        .ClearContents
    End With
    .Range("autoliqui").Value = ""
    .Range("ligne20:totaltva7").Borders.LineStyle = 1
    .Range("ligne20") = "TVA 20%"
    .Range("ligne10") = "TVA 10%"
    .Range("tvaglo").Value = "TVA GLOBALE"
    .Range("totaltva7").FormulaR1C1 = "=OFFSET(R[-1]C[-1],-4,9)"
    .Range("totaltva19").FormulaR1C1 = "=OFFSET(R[-1]C[-1],-3,10)"
    With .Range("totaltva19")
            .HorizontalAlignment = xlCenter
            .Font.Bold = False
            .NumberFormat = "#,##0.00 $"
        End With
    End With
End Sub

qui se lance par un appel par tous les autres boutons

j'ai fait ce choix pour ne pas influer sur le reste de la codification, donc j'ai mis un nouveau bouton car tout mes fournisseurs de pose de cuisines ne sont pas pour encore concerné à leurs dires, c'est pour cela que je n'ai pas remplacer le bouton "si cuisiniste"

Pascal

[grisan29]

bonjour a tous
je viens donner un code qui fonctionne pour créer un bas quand je fais une feuille d'acompte

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
Sub Macro1()
With Sheets("Feuil1")
 
     With .Range("suivant")
        .Offset(4) = "Arrêtée la présente facture à la somme de : "
        With .Offset(4)
            .Font.Bold = True
            .Font.Size = 14
            .Font.Name = "Arial"
            End With
        .Offset(4).Font.Underline = xlUnderlineStyleSingle
        With .Offset(5)
        .FormulaR1C1 = "=chiffrelettre(TTC)"
        .Font.Size = 14
        .Font.Name = "Arial"
        End With
        '.Offset(6, 5).MergeCells = True
        .Offset(7, 7) = "ACOMPTE RECU"
       With .Offset(7, 7)
        .Font.Bold = True
        .Font.Size = 14
        .Font.Name = "Arial"
        End With
        .Offset(7, 9).FormulaR1C1 = "=OFFSET(R[-1]C,-6,0)"
        .Offset(7, 9).NumberFormat = "#,##0.00 [$€-1]"
        With .Offset(7, 9)
        .Name = "TTC"
        .Font.Size = 14
        .Font.Name = "Arial"
        End With
        .Offset(8, 1) = "mode de paiement"
        With .Offset(8, 1)
        .Font.Bold = True
        .Font.Size = 14
        .Font.Name = "Arial"
        End With
       .Offset(8, 3) = "par chèque"
         With .Offset(8, 3)
        .Font.Size = 14
        .Font.Name = "Arial"
        End With
      End With
 
 
    End With
End Sub

ce code remplace le code que j'ai mis en dessous la ligne en commentaire dans le post http://www.developpez.net/forums/d13...n/#post7666195
Pascal