أتمتة إنشاء فاتورة بصيغة A4، إعداداتها، وأظرفة المراسلات في Excel باستخدام (VBA)
مرحباً بكم في مدونة Savoir et Partage (معرفة ومشاركة)! في تدبير الأنشطة المهنية أو المشاريع المعلوماتية، كيكون إنشاء الفواتير، متابعة بطاقات الزبناء، وتوجيه المراسلات البريدية من المهام اليومية لي كاتاخد بزاف ديال الوقت (chronophages). إيوا آش باليكم يلا خليناها Excel يقوم بهاد الخدمة كاملة وبنقرة واحدة فقط؟
فهاد المقال، غادي نشرحو بالتفصيل كود ماكرو VBA متكامل لي كايقوم بأتمتة 100% لإعداد وتنسيق فاتورة بقياس A4 مضبوط، وكيصاوب ورقة إعدادات ديناميكية فيها لائحـة الزبناء والأثمنة، وكيوجد كذلك ورقة لوجيستيكية خاصة بأظرفة المراسلات.
يلا كنتو كتفضلو تصاوبو الملف ديالكم بيديكم بلا ما تستعملو الكود، ما كاينش مشكل: غادي نشرحو أولاً البنية اليدوية خطوة بخطوة وبالمواقع المضبوطة للـ الخلايا. ومن بعد، غادي تلقاو الكود الكامل واجد للنسخ واللصق فآخر المقال.
1. لقطة موجزة على آش كيدير الماكرو (ملخص)
الماكرو كيقوم بثلاثة ديال العمليات رئيسية في ملف العمل ديالكم (Classeur):
-
كتنسيق الورقة النشطة (ActiveSheet): باش ترجع فاتورة أنيقة وبديزاين عصري (خط Aptos Narrow وألوان متناسقة)، ومبرمجة باش تطبع بشكل مثالي على ورقة A4 (الهوامش في الصفر).
-
كتنشأ ورقة ثانية باسم
Param_CL_et_PRIX: لي كتلعب دور قاعدة بيانات (رقم ICE للزبناء، أثمنة المنتوجات، ومسارات حفظ الملفات)، وكتزيد فيها قوائم منسدلة ذكية (Listes déroulantes). -
كتنشأ ورقة ثالثة باسم
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 ثانية:
-
حيلو محرر الـ VBA بالضغط على ALT + F11 في لوحة المفاتيح.
-
في العمود لي على اليسار (Explorateur de projets)، غادي تلقاو لائحة الأوراق.
-
كليكي مرة واحدة على الورقة المعنية باش تختارها.
-
يلا مابانتش ليكم نافذة الخصائص (Propriétés) لتحت على اليسار، وركو على الزر F4.
-
في لائحة الخصائص، شوفو السطر الأول كاع:
(Name)(لي مكتوب بين قوسين). -
بدلو القيمة لي على اليمين واكتبو بالضبط:
-
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