الرائد77

تفضل أخي . اضافة زر لضغط كل ملفات الموظف في مجلده بتعديل كود Ron ليناسب طلبك و رز للارسال الملف المضغوط عبر الايميل أنا وضعت هدا المسار الدي يحتوي على معلومات الموظفين C:\empfiles غير ما يناسبك داخل االاكواد TEST ATTACEHDfin.xlsm

بعد اذن أخي FoMaNsHeE معادلتك جيدة لكن الخطأ في ملف الاخ مداد_1423 المعادلة لا تصح . لأنك ادا وضعتها في المستحق الأول . تظهر المستحق 4500 و هو عنده غياب 1 يوم؟ كيف يحصل على االراتب كاملا و هو عنده 1 غياب ؟؟؟ و لو نزلت الى الثاني تطهر 450 +4200 = 4650 . و هي لا تساوي 4500 الراتب الشهري ؟؟ الخطأ هنا المشكل في ملف الطلب بحد ذاته . يحسب الايام 30 و يريد ناتج 28 +3 =30 ؟ كيف حضور 3 أيام و غياب 28 = 30 ؟ الاخ مداد_1423 اذا كنت تريد الحساب الصحيح . كيف 28 +3 =30 ؟ يجب أان تكون غياب 28 حضور 2 . أو حضور 3 أيام و غياب 27 و هذ المنطقي و تجد أن أصلا معادلتك أنت في ملف الطلب صحيحة. أو ضع 4500 على 31 و تجد الناتج بالتدقيق و الله أعلم

الكود الاصلي في ملف dll لا يصل اليه. عندما تضع برنام لا .لم اقل أن البرنامج لا يمكن لاكثر من مستخدم ؟؟؟ قلت انشء برنامجك لشخص ما تريد بيعه له. ضع سيريال نمبر الجهاز الخاص به في كودك . ثم ششفر مللفك . الكود يصبح في ملف dll . لا يمكن الوصول له أاما الكود الذي تراه فهو مشفر لا يمكن نقله أو تغييره لجهاز آخر . و اذا أردت بيع برنامجك لشخص آخر غير معلوومات الجهاز ثم شفره . و ارسله له مع ملف dll و الله أعلم

أخي saad abed شكرا و بارك الله فيك المثال المرفق كنموذج فقط.. الفكرة هي أن البرنامج الذي تبرمجه .لا يعمل الا على الجهاز المدخل رقمه التسلسلي. و لا يمكن لاحد سرقته. حتى لو أاخذ البرنامج عن طريق النسخ الى جهاز آخر . لن يشتغل و الاكواد محمية .. حتى لو تم نسخ الكود الذي رأيته بعد التشفير الى ملف جديد فإنه لا يعمل إلا كما الملف الاول. يعني اذا خصصت البرنامج لأحد معين .سيشتغل معه فقط. و الله أعلم

بارك الله فيك حبيبي Ali Mohamed Ali و جزاك الله خيرا

اقرا هذا الموضوع قد يناسبك

السلام عليكم نظرا لبعض طلبات الاعضاء الكرام . خاصة ممن يقومون بعمل برامج من أجل كسب العيش أعانهم الله فيما يخص حماية الاكواد التي بملفاتهم لانه عادة ما تحصل سرقة لبرامجهم و هذا بسبب ان أكسل لا يوفر الخماية الكاملة اضافة الى أن هناك برامج تقوم بكشف كلمات سر الملف ببساطة. لذلك اردت أن أقدم فكرة و هي تحويل الكود البرمجي الى ملف DLL مما يوفر حماية قوية للملف عن طريق برنامج vbacompiler for excel و لكن للاسف غير مجاني و هو برنامج يقوم بتحويل الاكواد بالملف الى ملف DLL و تغيير الاكواد بالملف لتستدعى ملف DLL الذي تم انشاؤه و يعمل الملف بكفاءءة عالية لقد قمت بالتجريب و فعلا نتيجة رائعة. يمكنك تحميل البرنامج كنسخة تجريبية . و بالنسبة للذين يعملون البرامج و يبيعونها و يكسبون العيش مننها يمكنهم شراء النسخة الكاملة كيف تحمي ملفك ؟ يمكنك وضع كود خاص بكلمة السر و السريال نمبر للهارد ديسك و ييمكنك وضع الكود التالي عند فتح الملف WORK BOOK OPEN يعني اذاكان رقم السريال نمبر هو مثلا : FFFFF-FFFFF-FFFFF ادخل الرقم السري 222222 و اذا كان خطأا اغلق الملف Private Sub Workbook_Open() Dim RAD As String If CreateObject("Scripting.FileSystemObject").GetDrive("C:\").SerialNumber = "FFFFF-FFFFF-FFFFF" Then RAD = InputBox("Enter password:") If LCaseRAD <> "222222" Then ActiveWorkbook.Close False End If End Sub و بعد الانتهاء من عمل ملف افتح برنامج vbacompiler for excel و جول ملفك الى ملف جديد معه ملف DLL يمكنك التجريب على أي ملف لقد قمت بتجريب البرنامج على ملف أحد الاعضاء و النتيجة بالمرفقات الملف عبارة عن كود بسيط يبحث عن تكرار في عمودين و نقل المكرر الى عمود ثالث هدا الكود مثلا قبل استعمال برنامج vbacompiler for excel Sub brg() ScreenUpdating = False Dim lr As Integer Dim lr1 As Integer Dim c As Range lr1 = ActiveSheet.Range("g" & Rows.Count).End(xlUp).Row For Each c In ActiveSheet.Range("c2:c1000") lr = ActiveSheet.Range("i" & Rows.Count).End(xlUp).Row If WorksheetFunction.CountIf(ActiveSheet.Range("g2:g" & lr1), c.Value) >= 1 Then Cells(lr + 1, 9) = c.Value On Error Resume Next End If Next ScreenUpdating = True End Sub و هذا بعد استعمال البرنامج #If Win64 Then Private Declare PtrSafe Sub p0iflwmc269 Lib "EXEMPLE_xlsm_64.dll" Alias "r8rfyae98n05rlq" () #Else Private Declare Sub p0iflwmc269 Lib "EXEMPLE_xlsm_64.dll" Alias "r8rfyae98n05rlq@0" () #End If Sub brg() p0iflwmc269 End Sub Option Private Module #If Win64 Then Private Declare PtrSafe Function SetThisWbk Lib "EXEMPLE_xlsm_64.dll" Alias "SetThisWorkbook" (ByVal twbk As Object) As Long Private Declare PtrSafe Function u6hpyov9dx5 Lib "EXEMPLE_xlsm_64.dll" (ByVal i As Long, ByVal obj As Object) As Long Private Declare PtrSafe Function c1smc91ey1mls Lib "EXEMPLE_xlsm_64.dll" (ByVal i As Long, ByVal mp As LongPtr) As Long Private Declare PtrSafe Function s1a3nzo1yqora3l Lib "EXEMPLE_xlsm_64.dll" () As Variant Private Declare PtrSafe Sub d0np2x0oglsn Lib "EXEMPLE_xlsm_64.dll" (ByVal dst As Any, ByVal src As LongPtr, ByVal sz As Long) Private Declare PtrSafe Function p8t9c8qi9tgx Lib "EXEMPLE_xlsm_64.dll" (ByRef p() As Any) As LongPtr Private Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal libFileName As String) As LongPtr Private Declare PtrSafe Function FreeLibrary Lib "kernel32" (ByVal hLibModule As LongPtr) As LongLong Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr #Else Private Declare Function SetThisWbk Lib "EXEMPLE_xlsm_64.dll" Alias "SetThisWorkbook@4" (ByVal twbk As Object) As Long Private Declare Function u6hpyov9dx5 Lib "EXEMPLE_xlsm_64.dll" Alias "u6hpyov9dx5@8" (ByVal i As Long,ByVal obj As Object) As Long Private Declare Function c1smc91ey1mls Lib "EXEMPLE_xlsm_64.dll" Alias "c1smc91ey1mls@8" (ByVal i As Long,ByVal mp As Long) As Long Private Declare Function s1a3nzo1yqora3l Lib "EXEMPLE_xlsm_64.dll" Alias "s1a3nzo1yqora3l@0" () As Variant Private Declare Sub d0np2x0oglsn Lib "EXEMPLE_xlsm_64.dll" Alias "d0np2x0oglsn@12" (ByVal dst As Any,ByVal src As Long,ByVal sz As Long) Private Declare Function p8t9c8qi9tgx Lib "EXEMPLE_xlsm_64.dll" Alias "p8t9c8qi9tgx@4" (ByRef p() As Any) As Long Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal libFileName As String) As Long Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long #End If Private Function k7wgf46mba0cj8() As String On Error Resume Next k7wgf46mba0cj8 = ThisWorkbook.Path + "\EXEMPLE_xlsm_64.dll" End Function Public Sub p8oi75y3jrid8() #If Win64 Then Dim hModule As LongPtr Dim dllPath As String Dim msg As String On Error Resume Next dllPath = k7wgf46mba0cj8() hModule = LoadLibrary(dllPath) If hModule = 0 Then MsgBox "Cannot load '" & dllPath & "'" ThisWorkbook.Close False Else c1smc91ey1mls 1&, AddressOf u4fw2npwzdn25f4 If SetThisWbk(ThisWorkbook) Then u6hpyov9dx5 3&, Sheet1 u6hpyov9dx5 4&, Sheet2 u6hpyov9dx5 2&, ThisWorkbook ThisWorkbook.Saved = True Else GoTo qpnt End If End If #Else MsgBox "This workbook can work with 64 bit Excel only" ThisWorkbook.Close False #End If Exit Sub qpnt: ThisWorkbook.Close False End Sub Public Sub x1u5slqd9g() On Error GoTo errh SetThisWbk (ThisWorkbook) Exit Sub errh: p8oi75y3jrid8 End Sub Public Function q7uobay8mw() As Boolean On Error Resume Next q7uobay8mw = GetModuleHandle("EXEMPLE_xlsm_64.dll") <> 0& End Function #If Win64 Then Public Function FreeCompiledDll() As LongLong Dim i As Long Do FreeCompiledDll = FreeLibrary(GetModuleHandle("EXEMPLE_xlsm_64.dll")) i = i + 1 Loop While FreeCompiledDll <> 0 And i < 100 End Function #End If Private Sub auto_open() x1u5slqd9g End Sub Private Sub auto_close() #If Win64 Then On Error Resume Next Dim p As Variant ThisWorkbook.Saved = True SetThisWbk Nothing p = s1a3nzo1yqora3l FreeCompiledDll If p <> "" Then Kill p & "cbinrtl.dll" RmDir p End If #End If End Sub Function u4fw2npwzdn25f4(ByVal v7liriqd8 As Variant, ByVal m8g6onrhcrw As Variant, ByVal m7jy4oel As Variant, ByRef j8yhrsbf2() As Variant) As Variant On Error Resume Next Dim sz As Long sz = UBound(j8yhrsbf2) - LBound(j8yhrsbf2) + 1 Select Case sz Case 0 u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel) Case 1 u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0)) Case 2 u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1)) Case 3 u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2)) Case 4 u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2), j8yhrsbf2(3)) Case 5 u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2), j8yhrsbf2(3), j8yhrsbf2(4)) Case 6 u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2), j8yhrsbf2(3), j8yhrsbf2(4), j8yhrsbf2(5)) Case 7 u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2), j8yhrsbf2(3), j8yhrsbf2(4), j8yhrsbf2(5), j8yhrsbf2(6)) Case 8 u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2), j8yhrsbf2(3), j8yhrsbf2(4), j8yhrsbf2(5), j8yhrsbf2(6), j8yhrsbf2(7)) Case 9 u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2), j8yhrsbf2(3), j8yhrsbf2(4), j8yhrsbf2(5), j8yhrsbf2(6), j8yhrsbf2(7), j8yhrsbf2(8)) Case 10 u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2), j8yhrsbf2(3), j8yhrsbf2(4), j8yhrsbf2(5), j8yhrsbf2(6), j8yhrsbf2(7), j8yhrsbf2(8), j8yhrsbf2(9)) End Select End Function و الملف يعمل بكفاءة جيدة يمكنكم التجربة من المرفقات ملف خاص بعد التشفير ب اوفيس 64 و ملف خاص بعد التشفير ب اوفيس 32 و السلام عليكم و تقبل الله منا و منكم الملف بدون تشفير.rar الملف مشفر مع ملف DLL لنسخة اوفيس 32.rar الملف مشفر مع ملف DLL لنسخة اوفيس 64.rar

تفضل EXEMPLE.xlsm

تفضل Book5.xlsx

السلام عليكم و رحمة الله و بركاته تفضل 1. تحقق من وجود mscomct2.ocx على جهازك ان وجدته ادهب مباشرة الى النقطة رقم 6 في أسفل االشرح ان لم تجده . 2- حمله من المرفقات الملف يعمل فقط لنسخ 32 بت للاكسل 2019-2016-2013 3- بالننسبة للونددوز 32-bit ضعه في هذا المسار C:\Windows\System32 بالننسبة للونددوز 64-bitضعه في هذا المسار C:\Windows\SysWoW64 4-الأن تسجيل الملف ادخل على قائمة إبدأ ثم Command Prompt و بالضغط على الزر الايمن اختر Run as Administrator. بالنسبة للوندوز 32 اكتب هذا الامر أو انسخه مباشرة C:\Windows\System32\regsvr32.exe mscomct2.ocx بالنسبة للوندوز 64 C:\Windows\SysWoW64\regsvr32.exe mscomct2.ocx 5-انسخ الامر و ضع المؤشر في Command Prompt ثم ااضغط الزر الايمن للفأرة . يلصق مباشرة ثم ENTER الان انتهيت من التسجيل 6-افتح اكسل ثم OPTIONS 7-الآن 8-ثم و بعد ذلك يمكنك ادرااجه من تبويب المطور أكرر فقط اوفيس 32 بت الصور من النت للأمانة و الحمد لله. MSCOMCT2.zip

Classeur1 (2).xlsx

تفضل تتغير اوتوماتيكيا حسب تغير اسم البرنامج. يمكنك سحب المعادلة في حالة اضافة برامج أخرى Classeur1.xlsx

مرحبا بك أخي وضح أكثر طلبك . بنفس صفحة ال stock control اريد بجانب اخر عمود مايفيد من خلال عملية الصرف والارجاع ان كان هناك عجز ام لا بعد ان اقوم بادخال الصادر والوارد؟ و بالنسبة للتقارير . لا توجد تقارير . صمم أنت صفحات التقارير و اشرح طلبك و ماتريده و أعد رفع الملف و إن شاء الله سيقوم الاساتذة بالباقي.

ادخل على خصائص الكمبوبوكس و اذهب الى textalign ثم اختر textalligtoright المصنف.xlsm

1.xlsx آسف أخي Ali Mohamed Ali لم الاحظ مشاركتك

تفضل أخي ضع هذا مكان الكود الذي تستعمله. تغيير بسيط على الكود الذي في الملف Sub REDA() Application.ScreenUpdating = False Dim iRow As Long Dim rng As Range Dim cl As Range Set rng = ActiveSheet.Range("c14:c23") For Each cl In rng If cl <> "" Then iRow = Sheets("SLS").Range("C1048576").End(xlUp).Row + 1 With ThisWorkbook.Sheets("SLS") .Range("B" & iRow).Value = iRow - 1 .Range("C" & iRow).Value = Sheets("INV").Range("D7").Value .Range("D" & iRow).Value = Sheets("INV").Range("D8").Value .Range("E" & iRow).Value = cl.Value .Range("F" & iRow).Value = cl.Offset(, 1).Value .Range("G" & iRow).Value = cl.Offset(, 2).Value .Range("H" & iRow).Value = cl.Offset(, 3).Value .Range("I" & iRow).Value = cl.Offset(, 4).Value .Range("J" & iRow).Value = Sheets("INV").Range("G24").Value .Range("K" & iRow).Value = Sheets("INV").Range("G25").Value .Range("L" & iRow).Value = Sheets("INV").Range("G26").Value .Range("M" & iRow).Value = Sheets("INV").Range("G27").Value End With End If Next Sheets("INV").Range("D8").Value = "" Sheets("INV").Range("C14").Value = "" Sheets("INV").Range("C15").Value = "" Sheets("INV").Range("C16").Value = "" Sheets("INV").Range("C17").Value = "" Sheets("INV").Range("C18").Value = "" Sheets("INV").Range("C19").Value = "" Sheets("INV").Range("C20").Value = "" Sheets("INV").Range("C21").Value = "" Sheets("INV").Range("C22").Value = "" Sheets("INV").Range("C23").Value = "" Sheets("INV").Range("E14").Value = "" Sheets("INV").Range("E15").Value = "" Sheets("INV").Range("E16").Value = "" Sheets("INV").Range("E17").Value = "" Sheets("INV").Range("E18").Value = "" Sheets("INV").Range("E19").Value = "" Sheets("INV").Range("E20").Value = "" Sheets("INV").Range("E21").Value = "" Sheets("INV").Range("E22").Value = "" Sheets("INV").Range("E23").Value = "" Sheets("INV").Range("F14").Value = "" Sheets("INV").Range("F15").Value = "" Sheets("INV").Range("F16").Value = "" Sheets("INV").Range("F17").Value = "" Sheets("INV").Range("F18").Value = "" Sheets("INV").Range("F19").Value = "" Sheets("INV").Range("F20").Value = "" Sheets("INV").Range("F21").Value = "" Sheets("INV").Range("F22").Value = "" Sheets("INV").Range("F23").Value = "" Sheets("INV").Range("G25").Value = "" Sheets("INV").Range("G26").Value = "" Application.ScreenUpdating = True End Sub

الملف الاخير به طلبكك. لا يستدعي االمبلغ عند عدم ووجود تتاريخ في الخزينة. بصراحة لم أفهم ما تريد.

تفضل أخي جلب المبلغ فقط حسب التاريخ في العمود A بدون تكرار. اختر من الخلية d1 عميل أو مورد ثم اضغط على جلب شيت حسابات (1).xlsm

الكود موجود افتح VBA و تجد الكود . ما تريده يا أخي خاص بنقل البيانات الى اكسل من برامج تحليل البيانات اللحظية و التاريخية الخاص بالبورصات . ادخل على المنتديات الخاصة بالبورصات . و ستجد ضالتك ان شاء الله

جرب هذا الكود لا تنسى تغيير مسار ملفات ميتاستوك . في الكود. الملف المرفق تجد شرح الكود. تجد ملفات الميتاستوك في مجلد DAILY في مسار برنامج TICKERCHART تأكد من وجود ملف EMASTER بالمجلد للأسف لا اشتغل على برنامج TICKERCHART حتى أتمكن مساعدتك أكثر. و لكن الكود الذي بالملف سيساعدك كثيرا ان شاء الله و لكي تلقى المساعدة الكاملة . يجب أن يكون هناك من يتعامل مع برنامج TICKERCHART بشكل جيد.حتى يتمكن من انشاء اكواد حسب ملفات الماستر و الاي ماستر . TICKERCHART.xlsm

على حسب ملفك المرفق. انظر المشتريات و الخزينة . على حسب جدول التقرير .ييا اخي كيف تأتي بالبيانات من الخزينة الى التقرير اسفل و ليس اصلا نفس الجدول. الكود يعمل و ياتي لك حسب المورد و العميل . على أاساس يأتي بالمبلغ فقط من الخزينة و لقد وضعت انت في ملفك الاول الخزينة فوق المبلغ. أي ياتي بالمبلغ من االخزينة. و الكود يعمل جيدا حسب هذا و هذه من التقرير رو هذه من الخزينة. و هذا عند تنفيذ الكود مثلا للمورد 1.. يطهر العمليات ما ببين التاريخيين . يعمل عادي.

تفضل Sub repport() Dim smch As Worksheet Dim smb As Worksheet Dim tres As Worksheet Dim targ As Worksheet Set smch = Sheets("المشتريات") Set smb = Sheets("المبيعات") Set tres = Sheets("الخزينة") Set targ = ActiveSheet lrm = smch.Range("c" & Rows.Count).End(xlUp).Row lrmb = smb.Range("c" & Rows.Count).End(xlUp).Row lrtres = tres.Range("c" & Rows.Count).End(xlUp).Row lrtg = targ.Range("a" & Rows.Count).End(xlUp).Row targ.Range("a9:e" & lrtg).ClearContents If targ.Range("d1") = "مورد" Then For Each cell In smch.Range("e5:e" & lrm) If cell.Value = targ.Range("d3") And cell.Offset(, -2).Value >= targ.Range("b2") And cell.Offset(, -2).Value <= targ.Range("b3") Then lrtg = targ.Range("a" & Rows.Count).End(xlUp).Row With targ .Cells(lrtg + 1, 1) = cell.Offset(, -2).Value .Cells(lrtg + 1, 2) = cell.Offset(, -1).Value .Cells(lrtg + 1, 3) = cell.Offset(, 5).Value For Each cell1 In tres.Range("j5:j" & lrtres) lrtg = targ.Range("a" & Rows.Count).End(xlUp).Row If cell1.Offset(, -4).Value = targ.Range("d3") And cell1.Value >= targ.Range("b2") And cell1.Value <= targ.Range("b3") Then .Cells(lrtg + 1, 4).Offset(-1, 0) = cell1.Offset(, -6).Value End If Next cell1 End With End If Next Else For Each cell In smb.Range("e5:e" & lrmb) If cell.Value = targ.Range("d3") And cell.Offset(, -2).Value >= targ.Range("b2") And cell.Offset(, -2).Value <= targ.Range("b3") Then lrtg = targ.Range("a" & Rows.Count).End(xlUp).Row With targ .Cells(lrtg + 1, 1) = cell.Offset(, -2).Value .Cells(lrtg + 1, 2) = cell.Offset(, -1).Value .Cells(lrtg + 1, 3) = cell.Offset(, 5).Value For Each cell1 In tres.Range("j5:j" & lrtres) lrtg = targ.Range("a" & Rows.Count).End(xlUp).Row If cell1.Offset(, -5).Value = targ.Range("d3") And cell1.Value >= targ.Range("b2") And cell1.Value <= targ.Range("b3") Then .Cells(lrtg + 1, 4).Offset(-1, 0) = cell1.Offset(, -6).Value End If Next cell1 End With End If Next End If End Sub شيت حسابات (1).xlsm

برنامج TickerChart لا يحتاج أن تغيرر في الروابط. افتج برنامج TickerChart و قم بالضغط على الزر الايمن للماوس . ثم بالاختيار الربط مع عنوان الاعمدة ،كما في الصورة. ثم افتح اكسل ب run as administrator ثم اختر a1 و لصق عادي و تتحدث المعطيات تلقائيا . و اذا كان عندك فكرة أخرى. اطرحها و ان شاء الله ستجد ما يناسبك

أظن أنه لا يمكن أخي أن تقوم بعمل تنسيق لكل عمود في اليست بوكس على جدا. و الله أعلم .

اليك الكود . تصدير ملف لكل زبون مهما كان العدد و حفظ باسم الزبون و رقمه .مع امكانية استبدال الملف في حالة وجوده سابقا. اما بالنسبة لإرساله كرساله. يجب وضع القائمة بالايميلات . و تثبيت outlook . يمكنك تغيير مجلد الحفظ في الكود C:\pdfs انشىء مجلد الحفط و قم بوضع المسار في الكود نموذج (1).xlsm