Aller au contenu

أتمتة إنشاء فاتورة، إعداداتها، وأظرف المراسلات

أتمتة إنشاء فاتورة بصيغة A4، إعداداتها، وأظرفة المراسلات في Excel باستخدام (VBA)

مرحباً بكم في مدونة Savoir et Partage (معرفة ومشاركة)! في تدبير الأنشطة المهنية أو المشاريع المعلوماتية، كيكون إنشاء الفواتير، متابعة بطاقات الزبناء، وتوجيه المراسلات البريدية من المهام اليومية لي كاتاخد بزاف ديال الوقت (chronophages). إيوا آش باليكم يلا خليناها Excel يقوم بهاد الخدمة كاملة وبنقرة واحدة فقط؟

فهاد المقال، غادي نشرحو بالتفصيل كود ماكرو VBA متكامل لي كايقوم بأتمتة 100% لإعداد وتنسيق فاتورة بقياس A4 مضبوط، وكيصاوب ورقة إعدادات ديناميكية فيها لائحـة الزبناء والأثمنة، وكيوجد كذلك ورقة لوجيستيكية خاصة بأظرفة المراسلات.

يلا كنتو كتفضلو تصاوبو الملف ديالكم بيديكم بلا ما تستعملو الكود، ما كاينش مشكل: غادي نشرحو أولاً البنية اليدوية خطوة بخطوة وبالمواقع المضبوطة للـ الخلايا. ومن بعد، غادي تلقاو الكود الكامل واجد للنسخ واللصق فآخر المقال.

1. لقطة موجزة على آش كيدير الماكرو (ملخص)

الماكرو كيقوم بثلاثة ديال العمليات رئيسية في ملف العمل ديالكم (Classeur):

  1. كتنسيق الورقة النشطة (ActiveSheet): باش ترجع فاتورة أنيقة وبديزاين عصري (خط Aptos Narrow وألوان متناسقة)، ومبرمجة باش تطبع بشكل مثالي على ورقة A4 (الهوامش في الصفر).

  2. كتنشأ ورقة ثانية باسم Param_CL_et_PRIX: لي كتلعب دور قاعدة بيانات (رقم ICE للزبناء، أثمنة المنتوجات، ومسارات حفظ الملفات)، وكتزيد فيها قوائم منسدلة ذكية (Listes déroulantes).

  3. كتنشأ ورقة ثالثة باسم Envlope_Adresse: كتنظم المعلومات اللوجيستيكية (الاسم، المدينة، والعنوان) باش تسهل عليكم إرسال البريد.

2. البنية الهندسة اليدوية للملف (Structure Manuelle)

يلا مابغيتوش تخدمو بالماكرو وبغيتو تقادو الملف بيديكم، هادو هما المواقع المضبوطة والإعدادات لي خاصكم تطبقوها:

الورقة 1: « Facture » (التنسيق والديزاين)

  • منطقة الطباعة A4: النطاق $C$8:$M$64 (الخلفية بيضاء). وباقي الخلايا في الورقة كاتاخد لون رمادي فاتح وأنيق.

  • رؤوس الجدول (السطر 24):

    • E24: المرجع REF (محاذاة إلى اليسار).

    • F24: الوصف DESCRIPTION (دمج الخلايا من F24 إلى G24 ومحاذاة إلى اليسار).

    • H24: الكمية Qté (في الوسط).

    • I24: الثمن دون رسوم PRIX HT (في الوسط).

    • J24: المجموع دون رسوم Total HT (دمج الخلايا من J24 إلى L24 وفي الوسط).

  • جسم الجدول (من السطر 25 إلى 41): خلايا الوصف (F:G) والمجموع (J:L) مدموجة سطر بسطر باش تخلي الكتابة واضحة ومنظمة.

  • إطار التاريخ والرقم: * I15 (« : Date ») و I16 (« : N° ») بمحاذاة إلى اليمين.

    • J15:L15 (مدموجة) فيها الصيغة =AUJOURDHUI() باش يعطي التاريخ تلقائياً.

  • منطقة المراقبة غير المرئية: الخلية B24 صالحة لتخزين تاريخ انتهاء الصلاحية المحوري، وكنسميوها Date_Fin_Old_CM.

الورقة 2: « Param_CL_et_PRIX » (جداول البيانات)

هاد الورقة كتجمع بزاف ديال جداول Excel المنظمة (ListObjects) وموزعة بطريقة دقيقة:

اسم الجدول الموقع (النطاق) الوصف / المحتوى
Clients G10:AE20 فيه 25 عمود (الاسم، ICE، المدينة، المسؤول، العنوان، تتبع رخص المنتوجات 1 و 2 و 3، الموقع الإلكتروني، ورسائل SMS).
Produits AN10:AP35 دليل الأثمنة فيه 3 أعمدة: الوصف، المرجع، والثمن (مُنسق بـ ##0,00 "DH").
Periode_facture AK1:AQ3 حساب تلقائي للتواريخ ونصوص فترات الصيانة (السنة المقبلة، نهاية الشهر، إلخ).
Tabl_maintenance1 AR10:AS20 تفاصيل خدمات الصيانة للمنتوج الأول (Maintenance Produit 1).
Tabl_maintenance2 AU10:AV20 تفاصيل خدمات الصيانة للمنتوج الثاني (Maintenance Produit 2).
Tabl_maintenance3 AX10:AY20 الإعدادات الكاملة (المنتوج 1 + المنتوج 2 + الموقع الإلكتروني).

💡 سر القوائم المنسدلة: كاين نطاق مسمى (Plage nommée) باسم Designation_ref_prix مرتبط بعمود « Désignation » في جدول Produits. هاد النطاق كنستعملوه كشرط للتحقق من صحة البيانات (Validation des données) باش يعطينا قوائم منسدلة تلقائية في جدول الفاتورة (F25:G41) وجداول الصيانة.

الورقة 3: « Envlope_Adresse » (لوجيستيك المراسلات)

يلا صاوبتو هاد الورقة بيديكم، طبقو هاد العناوين في السطر الأول:

  • الخلية A1: Nom (عرض العمود المنصوح به: 30)

  • الخلية B1: Ville (عرض العمود المنصوح به: 15)

  • الخلية C1: Adresse (عرض العمود المنصوح به: 50)

3. الصيغ الأساسية (Les Formules Clés) المدمجة في النظام

باش نضمنوا ديناميكية تواريخ الاشتراكات والصيانة، جدول Periode_facture كيخدم بهاد الصيغ المحلية:

  • حساب الفترة السنوية القياسية (السطر 2):

    • بداية الشهر السابق: =DATE(ANNEE(AK2);MOIS(AK2)-1;1)

    • نهاية الشهر السابق: =FIN.MOIS(AL2;0)

    • تاريخ الاستحقاق (+365 يوم): =AN2+365

    • نص الفترة: تجميع تلقائي باستخدام الدالة TEXTE(Date; "00/00/AAAA").

4. حيلة المحترفين: تغيير الـ « CodeName » للرّقاقات يدوياً (Méthode Manuelle)

في عالم الـ VBA، كاين جوج سميات لكل ورقة في Excel: السمية العادية لي كتبان في التبويب (Onglet) لتحت في الشاشة، والـ CodeName (الاسم الداخلي للورقة لي كيخدمو بيه المبرمجين). باش تبدل هاد الاسم الداخلي بكود VBA، خاصك تبدل إعدادات الأمان العامة لـ Excel وتسمح بالولوج للمشروع، وهادشي كيدير مشاكل وبلوكاج عند المستخدمين الآخرين.

وبما أن الطريقة السهلة هي ديما الفعالة، هاهي كيفاش تبدلو الـ CodeName لـ 3 ديال الأوراق بيديكم في أقل من 15 ثانية:

  1. حيلو محرر الـ VBA بالضغط على ALT + F11 في لوحة المفاتيح.

  2. في العمود لي على اليسار (Explorateur de projets)، غادي تلقاو لائحة الأوراق.

  3. كليكي مرة واحدة على الورقة المعنية باش تختارها.

  4. يلا مابانتش ليكم نافذة الخصائص (Propriétés) لتحت على اليسار، وركو على الزر F4.

  5. في لائحة الخصائص، شوفو السطر الأول كاع: (Name) (لي مكتوب بين قوسين).

  6. بدلو القيمة لي على اليمين واكتبو بالضبط:

    • Facture بالنسبة لورقة الفاتورة.

    • Param_CL_et_PRIX بالنسبة لورقة الإعدادات.

    • Envlope_Adresse بالنسبة لورقة الأظرفة والمراسلات الجديدة.

بفضل هاد العملية، المشروع ديالكم كيولي محمي 100%: حتى يلا جا شي زميل وبدل السمية ديال علامة التبويب (Onglet) لتحت في Excel (مثلاً رجعها « Courriers » أو « Parameters » )، الكود والماكرو غادي يبقاو خدامين وماراديش يوقع فيهم خطأ نهائياً!

5. كود VBA الشامل: صاوب المشروع بـ « نقرة واحدة »

باش تثبتوا هاد الكود: حيلو ملف العمل ديالكم، ضغطو على ALT + F11، زيدو موديل جديد (Insertion > Module)، صقو فيه هاد الكود (Script) لي لتحت، ومن بعد سدو النافذة وطلقو الماكرو!





Sub Generer_Facture_Et_Configuration_Global()
    Dim wsFacture As Worksheet, wsParam As Worksheet, wsEnveloppe As Worksheet
    Dim SH As Shape
    Dim plageFacture As String
    Dim tbl As ListObject
    Dim Entetes As Variant, Clients As Variant, tName As Variant
    Dim i As Integer

    ' 1. INITIALISATION ET OPTIMISATION DE L'ENVIRONNEMENT
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set wsFacture = ActiveSheet
    plageFacture = "$C$8:$M$64"

    On Error Resume Next
    wsFacture.Name = "Facture"
    On Error GoTo 0

    ' 2. CONSTRUCTION DE LA ZONE DE FACTURATION (A4)
    With wsFacture.Cells.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.899990844447157
    End With
    
    With wsFacture.Range(plageFacture).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    
    wsFacture.Columns("C:D").ColumnWidth = 4
    wsFacture.Columns("E:E").ColumnWidth = 21
    wsFacture.Columns("F:G").ColumnWidth = 25
    wsFacture.Columns("H:H").ColumnWidth = 10.14
    wsFacture.Columns("I:I").ColumnWidth = 18
    wsFacture.Columns("J:K").ColumnWidth = 5
    wsFacture.Columns("L:M").ColumnWidth = 10
    
    wsFacture.Rows("8:11").RowHeight = 14
    wsFacture.Rows("12:12").RowHeight = 30
    wsFacture.Rows("14:14").RowHeight = 14
    wsFacture.Rows("15:16").RowHeight = 15.75
    wsFacture.Rows("24:24").RowHeight = 25
    wsFacture.Rows("25:37").RowHeight = 35.5
    wsFacture.Rows("43:47").RowHeight = 20
    wsFacture.Rows("52:52").RowHeight = 30
    wsFacture.Rows("53:64").RowHeight = 12
    
    wsFacture.Range("E24").Value = "REF"
    wsFacture.Range("F24").Value = "DESCRIPTION"
    wsFacture.Range("H24").Value = "Qté"
    wsFacture.Range("I24").Value = "PRIX HT"
    wsFacture.Range("J24").Value = "Total HT"
    wsFacture.Range("J24:L24").Merge
    
    With wsFacture.Range("E24:L24").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.249977111117893
    End With
    
    With wsFacture.Range("E24:L24")
        .VerticalAlignment = xlCenter
        With .Font
            .Name = "Aptos Narrow"
            .Size = 12
            .Bold = True
            .ThemeColor = xlThemeColorDark1
        End With
    End With
    
    wsFacture.Range("E24:F24").HorizontalAlignment = xlLeft
    wsFacture.Range("H24:J24").HorizontalAlignment = xlCenter
    
    For i = 25 To 41
        With wsFacture.Range("J" & i & ":L" & i)
            .Merge
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
        End With
        With wsFacture.Range("F" & i & ":G" & i)
            .Merge
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
        End With
    Next i
    
    With wsFacture.Range("M9:M64")
        .Font.ColorIndex = xlAutomatic
        .Interior.ThemeColor = xlThemeColorDark1
    End With
    
    On Error Resume Next
    wsFacture.Shapes("TextBox_Titre_Facture").Delete
    On Error GoTo 0
    
    Set SH = wsFacture.Shapes.AddTextbox(msoTextOrientationHorizontal, 520, 45, 150, 40)
    With SH
        .Name = "TextBox_Titre_Facture"
        .Fill.Visible = msoFalse
        .Line.Visible = msoFalse
        With .TextFrame2
            .VerticalAnchor = msoAnchorMiddle
            With .TextRange
                .Text = "FACTURE"
                .ParagraphFormat.Alignment = msoAlignCenter
                With .Font
                    .Name = "Aptos Narrow"
                    .Size = 24
                    .Bold = True
                    .Kerning = 5
                    .Fill.ForeColor.RGB = RGB(0, 0, 0)
                End With
            End With
        End With
    End With
    
    wsFacture.Range("I15").Value = "Date :"
    wsFacture.Range("I16").Value = "N° :"
    wsFacture.Range("J15:L15").Merge
    wsFacture.Range("J15").FormulaR1C1 = "=TODAY()"
    wsFacture.Range("J16:L16").Merge
    
    wsFacture.Range("I15:I16").HorizontalAlignment = xlRight
    wsFacture.Range("J15:L16").HorizontalAlignment = xlCenter
    
    wsFacture.Range("J52").Value = "La direction"
    wsFacture.Range("E50:L51").Merge
    wsFacture.Range("E50:L51").HorizontalAlignment = xlCenter
    wsFacture.Range("E50:L51").VerticalAlignment = xlBottom
    
    With Union(wsFacture.Range("I15:L16"), wsFacture.Range("J52")).Font
        .Name = "Aptos Narrow"
        .Size = 12
        .Bold = True
        .Color = RGB(0, 0, 0)
    End With
    
    With wsFacture.PageSetup
        .PrintArea = plageFacture
        .FitToPagesTall = 1
        .FitToPagesWide = 1
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .Zoom = False
        .Orientation = xlPortrait
        .PaperSize = xlPaperA4
        .PrintHeadings = False
        .PrintGridlines = False
    End With

    On Error Resume Next
    ActiveWorkbook.Names("Date_Fin_Old_CM").Delete
    On Error GoTo 0

    ActiveWorkbook.Names.Add Name:="Date_Fin_Old_CM", RefersTo:="='" & wsFacture.Name & "'!$B$24"
    
    With wsFacture.Range("B24")
        .Font.ColorIndex = xlAutomatic
        .Interior.ThemeColor = xlThemeColorDark1
        .Interior.TintAndShade = -0.149998474074526
        .NumberFormat = "m/d/yyyy"
        .FormulaR1C1 = "=TODAY()"
    End With

    ' 3. CRÉATION ET REMPLISSAGE DE LA FEUILLE DE PARAMÈTRES
    On Error Resume Next
    Sheets("Param_CL_et_PRIX").Delete
    On Error GoTo 0

    Set wsParam = Worksheets.Add(After:=wsFacture)
    wsParam.Name = "Param_CL_et_PRIX"

' --- TABLEAU : CLIENTS (25 éléments par sous-array) ---
    wsParam.Range("G9").Value = "Information des clients"
    Entetes = Array( _
        "Nom Facture", "Nom", "ICE", "Ville", "Responsable", _
        "Interlocuteur", "Adresse", "N°TEL", "EMAIL", _
        "Produit 1", "Pr1 Type Lic", "Pr1 Dt Lic", "Pr1 Dt MNT", _
        "Produit 2", "Pr2 Type Lic", "Pr2 Dt Lic", "Pr2 Dt MNT", _
        "Produit 3", "Pr3 Type Lic", "Pr3 Dt Lic", "Pr3 Dt MNT", _
        "Site Web Type Lic", "Site Web Dt Lic", "Site Web Dt MNT", _
        "Pr4 Forfait SMS")

    wsParam.Range("G10").Resize(1, UBound(Entetes) + 1).Value = Entetes

    Clients = Array( _
        Array("Etablissement SONBOLA", "Etablissement SONBOLA", "00**63720082", "RABAT", "JAMAL", "JAMAL", "AVENUE Abdelhadi ,Rue 3, N°4 Lots bourgogne", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", ""), _
        Array("Groupe Scolaire ALEP", "Groupe Scolaire ALEP", "00**66**660**3", "RABAT", "ABDESLAM", "ABDESLAM", "AVENUE Abdelhadi ,Rue 3, N°4 Lots bourgogne", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", ""), _
        Array("Institut Azzaitouna", "Institut Azzaitouna", "00**6686820**", "RABAT", "MME KHADIJA", "MME KHADIJA", "AVENUE Abdelhadi ,Rue 3, N°4 Lots bourgogne", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", ""), _
        Array("Complexe Scolaire le POINT", "Complexe Scolaire le POINT", "00**623874008**", "CASABLANCA", "ABDELOUAHD", "ABDELOUAHD", "AVENUE Abdelhadi ,Rue 3, N°4 Lots bourgogne", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", ""), _
        Array("Complexe Scolaire Zahira", "Complexe Scolaire Zahira", "0024**97860068", "MEKNÈS", "KARIMA", "KARIMA", "AVENUE Abdelhadi ,Rue 3, N°4 Lots bourgogne", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", ""), _
        Array("GROUPE SCOLAIRE Hafida", "GROUPE SCOLAIRE Hafida", "", "CASABLANCA", "IHSSANE", "IHSSANE", "AVENUE Abdelhadi ,Rue 3, N°4 Lots bourgogne", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", ""), _
        Array("INSTITUT DES SCIENCES", "INSTITUT DES SCIENCES", "", "TETOUAN", "MOHAMED", "MOHAMED", "AVENUE Abdelhadi ,Rue 3, N°4 Lots bourgogne", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", ""), _
        Array("Ecole Al Awal", "Ecole Al Awal", "00**87476036", "RABAT", "IDRISSE", "IDRISSE", "AVENUE Abdelhadi ,Rue 3, N°4 Lots bourgogne", "", "", "", "", "", "", "", "", "", "", "", canvas, "", "", "", "", "", ""), _
        Array("Institution El Omari", "Institution El Omari", "", "CASABLANCA", "MEHDI", "MEHDI", "AVENUE Abdelhadi ,Rue 3, N°4 Lots bourgogne", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", ""), _
        Array("Institut NARD", "Institut NARD", "", "TETOUAN", "RACHED", "RACHED", "AVENUE Abdelhadi ,Rue 3, N°4 Lots bourgogne", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "") _
    )

    ' Écriture ligne par ligne dans la feuille Excel
    For i = LBound(Clients) To UBound(Clients)
        wsParam.Cells(11 + i, "G").Resize(1, UBound(Entetes) + 1).Value = Clients(i)
    Next i


    Set tbl = wsParam.ListObjects.Add(xlSrcRange, wsParam.Range("G10").Resize(UBound(Clients) + 2, UBound(Entetes) + 1), , xlYes)
    tbl.Name = "Clients"

    ' --- TABLEAU : PRODUITS ET TARIFS ---
    wsParam.Range("AN8").Value = "Information des produits"
    wsParam.Range("AN9").Value = "veuillez saisir les Information des produits"
    wsParam.Range("AN10").Resize(1, 3).Value = Array("Désignation", "Référence", "Prix")

    wsParam.Range("AN11").Resize(1, 3).Value = Array("Maintenance Produit 1 Professionnelle", "CM-MP", 2500)
    wsParam.Range("AN12").Resize(1, 3).Value = Array("• Droit d’utilisation annuelle" & vbLf & "• Mises à jour correctives" & vbLf & "• Assistance" & vbLf & "• USL-1000", "", "")
    wsParam.Range("AN13").Resize(1, 3).Value = Array("=Date_Licence_plus1", "", "")
    wsParam.Range("AN14").Resize(1, 3).Value = Array("Maintenance Produit 1 Medium", "CM-MM", 1900)
    wsParam.Range("AN15").Resize(1, 3).Value = Array("Maintenance Produit 1 Small", "CM-MS", 1020)
    wsParam.Range("AN16").Resize(1, 3).Value = Array("Maintenance Produit 2 Profil", "CM-EM", 2475)
    wsParam.Range("AN17").Resize(1, 3).Value = Array("Licence Produit 1 Professionnelle", "LIC-MP", 13100)
    wsParam.Range("AN18").Resize(1, 3).Value = Array("Licence Produit 1 Medium", "LIC-MM", 9480)
    wsParam.Range("AN19").Resize(1, 3).Value = Array("Poste client supplémentaire", "M-PCS", 690)
    wsParam.Range("AN20").Resize(1, 3).Value = Array("Création d'un site web", "CM-SW", 6000)
    wsParam.Range("AN21").Resize(1, 3).Value = Array("Passage à la version V12 de Produit 1", "PASS", 4100)
    wsParam.Range("AN22").Resize(1, 3).Value = Array("Maintenance Produit 1 Crèche", "CM-MC", 1000)
    wsParam.Range("AN23").Resize(1, 3).Value = Array("Maintenance Produit 1 Start Up", "CM-SU", 1000)
    wsParam.Range("AN24").Resize(1, 3).Value = Array("Licence Produit 2 Profil", "Lic-EM", 2920)
    wsParam.Range("AN25").Resize(1, 3).Value = Array("Maintenance Produit 1 Produit 2", "CM-ME", 8982)
    wsParam.Range("AN26").Resize(1, 3).Value = Array("Passage de SMALL vers MEDIUM", "PASS", 5280)
    wsParam.Range("AN27").Resize(1, 3).Value = Array("Licence Pack Connect Professionnel", "Lic-CP", 16820)
    wsParam.Range("AN28").Resize(1, 3).Value = Array("Frais d'activation de service", "FAS", 500)
    wsParam.Range("AN29").Resize(1, 3).Value = Array("Maintenance Produit 1", "MM", 1000)
    wsParam.Range("AN30").Resize(1, 3).Value = Array("Maintenance module Paie de Produit 1", "M-MP", 1000)
    wsParam.Range("AN31").Resize(1, 3).Value = Array("Licence Produit 1 SMALL", "LIC-MS", 4200)
    wsParam.Range("AN32").Resize(1, 3).Value = Array("=Date_Maintenance_old_plus1", "", "")
    wsParam.Range("AN33").Resize(1, 3).Value = Array("Maintenance annuelle Produit 1 Produit 2", "CM-ME", 10500)
    wsParam.Range("AN34").Resize(1, 3).Value = Array("Maintenance Site Web", "CM-ME", 1200)
    wsParam.Range("AN35").Resize(1, 3).Value = Array("Maintenance Produit 2 Mobile", "CM-eMM", 17850)
    
    wsParam.Range("AP11:AP35").NumberFormat = "# ##0,00 ""DH"""

    Set tbl = wsParam.ListObjects.Add(xlSrcRange, wsParam.Range("AN10:AP35"), , xlYes)
    tbl.Name = "Produits"

    ' --- TABLEAU : PÉRIODE FACTURE ---
    wsParam.Range("AK1:AQ1").Value = Array("Date", "début mois", "fin mois", "Année moins 1", "Année plus 1", "Periode Mois", "Periode Année")
    
    wsParam.Range("AK2").FormulaLocal = "=AUJOURDHUI()"
    wsParam.Range("AL2").FormulaLocal = "=DATE(ANNEE(AK2);MOIS(AK2)-1;1)"
    wsParam.Range("AM2").FormulaLocal = "=FIN.MOIS(AL2;0)"
    wsParam.Range("AN2").FormulaLocal = "=AK2"
    wsParam.Range("AO2").FormulaLocal = "=AN2+365"
    wsParam.Range("AP2").FormulaLocal = "=""Période du ""&TEXTE(JOUR(AL2);""00"")&""/""&TEXTE(MOIS(AL2);""00"")&""/""&TEXTE(ANNEE(AL2);""0000"")&"" au ""&TEXTE(JOUR(AM2);""00"")&""/""&TEXTE(MOIS(AM2);""00"")&""/""&TEXTE(AM2;""AAAA"")"
    wsParam.Range("AQ2").FormulaLocal = "=""Période du ""&TEXTE(JOUR(AN2);""00"")&""/""&TEXTE(MOIS(AN2);""00"")&""/""&TEXTE(ANNEE(AN2);""0000"")&"" au ""&TEXTE(JOUR(AO2);""00"")&""/""&TEXTE(MOIS(AO2);""00"")&""/""&TEXTE(AO2;""AAAA"")"

    wsParam.Range("AK3").Formula = "=Date_Fin_Old_CM"
    wsParam.Range("AL3").FormulaLocal = "=DATE(ANNEE(AK3);MOIS(AK3)-1;1)"
    wsParam.Range("AM3").FormulaLocal = "=FIN.MOIS(AL3;0)"
    wsParam.Range("AN3").FormulaLocal = "=AK3"
    wsParam.Range("AO3").FormulaLocal = "=AN3+365"
    wsParam.Range("AP3").FormulaLocal = "=""Période du ""&TEXTE(JOUR(AL3);""00"")&""/""&TEXTE(MOIS(AL3);""00"")&""/""&TEXTE(ANNEE(AL3);""0000"")&"" au ""&TEXTE(JOUR(AM3);""00"")&""/""&TEXTE(MOIS(AM3);""00"")&""/""&TEXTE(AM3;""AAAA"")"
    wsParam.Range("AQ3").FormulaLocal = "=""Période du ""&TEXTE(JOUR(AN3);""00"")&""/""&TEXTE(MOIS(AN3);""00"")&""/""&TEXTE(ANNEE(AN3);""0000"")&"" au ""&TEXTE(JOUR(AO3);""00"")&""/""&TEXTE(MOIS(AO3);""00"")&""/""&TEXTE(AO3;""AAAA"")"

    Set tbl = wsParam.ListObjects.Add(xlSrcRange, wsParam.Range("AK1:AQ3"), , xlYes)
    tbl.Name = "Periode_facture"
    wsParam.Range("Periode_facture[[Date]:[Année plus 1]]").NumberFormat = "m/d/yyyy"

    ThisWorkbook.Names.Add Name:="Date_Licence_plus1", RefersTo:=wsParam.Range("AQ2")
    ThisWorkbook.Names.Add Name:="Date_Maintenance_old_plus1", RefersTo:=wsParam.Range("AQ3")

    ' --- TABLEAUX DE MAINTENANCE (1, 2, 3) ---
    wsParam.Range("AR8").Value = "Information Macro maintenance 1"
    wsParam.Range("AR10:AS10").Value = Array("Référence", "Désignation")
    wsParam.Range("AR11").Value = "1 element": wsParam.Range("AS11").Value = "Maintenance Produit 1 Professionnelle"
    wsParam.Range("AR12").Value = "2 element": wsParam.Range("AS12").Value = "• Droit d’utilisation annuelle" & vbLf & "• Mises à jour correctives" & vbLf & "• Assistance"
    wsParam.Range("AR13").Value = "3 element": wsParam.Range("AS13").Formula = "=Date_Maintenance_old_plus1"
    For i = 4 To 10: wsParam.Cells(10 + i, "AR").Value = i & " element": Next i
    Set tbl = wsParam.ListObjects.Add(xlSrcRange, wsParam.Range("AR10:AS20"), , xlYes)
    tbl.Name = "Tabl_maintenance1"

    wsParam.Range("AU8").Value = "Information Macro maintenance 2 MAD_EMAD"
    wsParam.Range("AU10:AV10").Value = Array("Référence", "Désignation")
    wsParam.Range("AU11").Value = "1 element": wsParam.Range("AV11").Value = "Maintenance Produit 2 Profil"
    wsParam.Range("AU12").Value = "2 element": wsParam.Range("AV12").Value = "• Droit d’utilisation annuelle" & vbLf & "• Mises à jour correctives" & vbLf & "• Assistance"
    wsParam.Range("AU13").Value = "3 element": wsParam.Range("AV13").Formula = "=Date_Maintenance_old_plus1"
    wsParam.Range("AU14").Value = "4 element": wsParam.Range("AV14").Value = "Maintenance Produit 1 Professionnelle"
    wsParam.Range("AU15").Value = "5 element": wsParam.Range("AV15").Value = "• Droit d’utilisation annuelle" & vbLf & "• Mises à jour correctives" & vbLf & "• Assistance"
    wsParam.Range("AU16").Value = "6 element": wsParam.Range("AV16").Formula = "=Date_Maintenance_old_plus1"
    For i = 7 To 10: wsParam.Cells(10 + i, "AU").Value = i & " element": Next i
    Set tbl = wsParam.ListObjects.Add(xlSrcRange, wsParam.Range("AU10:AV20"), , xlYes)
    tbl.Name = "Tabl_maintenance2"

    wsParam.Range("AX8").Value = "Information Macro maintenance 3 mainte_MAD_EMAD_site"
    wsParam.Range("AX10:AY10").Value = Array("Référence", "Désignation")
    wsParam.Range("AX11").Value = "1 element": wsParam.Range("AY11").Value = "Maintenance Produit 2 Profil"
    wsParam.Range("AX12").Value = "2 element": wsParam.Range("AY12").Value = "• Droit d’utilisation annuelle" & vbLf & "• Mises à jour correctives" & vbLf & "• Assistance"
    wsParam.Range("AX13").Value = "3 element": wsParam.Range("AY13").Formula = "=Date_Maintenance_old_plus1"
    wsParam.Range("AX14").Value = "4 element": wsParam.Range("AY14").Value = "Maintenance Produit 1 Professionnelle"
    wsParam.Range("AX15").Value = "5 element": wsParam.Range("AY15").Value = "• Droit d’utilisation annuelle" & vbLf & "• Mises à jour correctives" & vbLf & "• Assistance"
    wsParam.Range("AX16").Value = "6 element": wsParam.Range("AY16").Formula = "=Date_Maintenance_old_plus1"
    wsParam.Range("AX17").Value = "7 element": wsParam.Range("AY17").Value = "Maintenance Site Web"
    wsParam.Range("AX18").Value = "8 element": wsParam.Range("AY18").Formula = "=Date_Maintenance_old_plus1"
    wsParam.Range("AX20").Value = "10 element"
    Set tbl = wsParam.ListObjects.Add(xlSrcRange, wsParam.Range("AX10:AY20"), , xlYes)
    tbl.Name = "Tabl_maintenance3"

    ' 4. MISE EN PAGE ET VALIDATIONS
    wsParam.Columns("A:F").ColumnWidth = 1
    wsParam.Columns("AQ:AQ").EntireColumn.AutoFit
    wsParam.Columns("AS:AS").EntireColumn.AutoFit
    wsParam.Columns("AV:AV").EntireColumn.AutoFit
    wsParam.Columns("AY:AY").EntireColumn.AutoFit
    wsParam.Columns("AN:AN").EntireColumn.AutoFit
    wsParam.Columns("AO:AO").ColumnWidth = 13.57
    wsParam.Columns("E:E").ColumnWidth = 12.33
    wsParam.Columns("B:B").ColumnWidth = 20.67

'
ActiveWorkbook.Names.Add Name:="Designation_ref_prix", _
    RefersTo:="='" & wsParam.Name & "'!Produits[Désignation]"
    

    For Each tName In Array("Tabl_maintenance1[Désignation]", "Tabl_maintenance2[Désignation]", "Tabl_maintenance3[Désignation]")
        With wsParam.Range(tName).Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="=Designation_ref_prix"
            .ShowError = False
        End With
    Next tName

    With wsFacture.Range("F25:G41").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="=Designation_ref_prix"
        .ShowError = False
    End With

    wsParam.Range("A2").Value = "Dossiers d'enregistrement "
    wsParam.Range("A3").Value = "Veuillez saisir les Dossiers d'enregistrement"
    wsParam.Range("A5").Value = "Devis":          wsParam.Range("B5").Value = "C:\devis"
    wsParam.Range("A6").Value = "Bon commande":  wsParam.Range("B6").Value = "C:\BC"
    wsParam.Range("A7").Value = "Bon livraison":  wsParam.Range("B7").Value = "C:\BL"
    wsParam.Range("A8").Value = "Facture":        wsParam.Range("B8").Value = "C:\Facture"

    wsParam.Select
    wsParam.Range("G11").Select
    ActiveWindow.FreezePanes = True

    ' =========================================================================
    ' 5. CRÉATION ET REMPLISSAGE DE LA FEUILLE ADRESSE ENVELOPPE
    ' =========================================================================
    On Error Resume Next
    Sheets("Envlope_Adresse").Delete
    On Error GoTo 0

    Set wsEnveloppe = Worksheets.Add(After:=wsParam)
    wsEnveloppe.Name = "Envlope_Adresse"

    ' Remplissage des en-têtes
    wsEnveloppe.Range("A1").Value = "Nom"
    wsEnveloppe.Range("B1").Value = "Ville"
    wsEnveloppe.Range("C1").Value = "Adresse"

    ' Design rapide pour la feuille Enveloppe
    With wsEnveloppe.Range("A1:C1")
        .Font.Name = "Aptos Narrow"
        .Font.Size = 11
        .Font.Bold = True
        .Font.Color = RGB(255, 255, 255)
        .Interior.Color = RGB(64, 64, 64)
        .HorizontalAlignment = xlCenter
    End With

    ' Ajustement des colonnes pour les adresses
    wsEnveloppe.Columns("A:A").ColumnWidth = 30
    wsEnveloppe.Columns("B:B").ColumnWidth = 15
    wsEnveloppe.Columns("C:C").ColumnWidth = 50

    ' Finition et retour écran
    wsFacture.Select
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    MsgBox "Le système complet (Facture + Paramètres + Adresses Enveloppes) a été généré avec succès !", vbInformation, "Savoir et Partage"
End Sub
https://www.youtube.com/watch?v=XmSIKdTXZm4

Laisser un commentaire

Votre adresse e-mail ne sera pas publiée. Les champs obligatoires sont indiqués avec *