نجوم المشاركات

وعليكم السلام ورحمة الله وبركاته ملفك لا بحتوى على اي كود تم عمل كود لطلبك والكود مرن يطبع الى اخر صف قيه بيانات Sub PrPAGES() Dim printWS As Worksheet Dim lastRow As Long Dim printRange As Range Set printWS = ThisWorkbook.Sheets("S1") lastRow = printWS.Cells(printWS.Rows.Count, "A").End(xlUp).Row Set printRange = printWS.Range("A1:C" & lastRow) printWS.PageSetup.PrintArea = printRange.Address printWS.PrintOut End Sub 1نموذج.xlsb

ماشاء الله عليك اخي ابو خليل مستمر في العطاء في المنتدى تغيرت الكثير من الاسماء والثابت الوحيد الى الان هو ابو خليل

وعليكم السلام ورحمة الله وبركاته ،، أهلا بعودتكم أستاذنا الفاضل @منتصر الانسي ، وبعد عودتكم بفكرة جميلة جداً .. فسلمت على هذه الفكرة الجميلة اهتمامك حتى بفكرة الترقيم لللفاتورة جاءت بطريقة ذكية

وعليكم السلام ورحمة الله تعالى وبركاته حل اخر لتجاهل ورقة ff مثلا Option Explicit Sub call1() Dim CrWS As Worksheet, WS As Worksheet Dim Tbl As Integer, lastCol As Integer Set CrWS = ThisWorkbook.Sheets("ff") Tbl = 4 lastCol = 21 CrWS.Range(CrWS.Cells(3, Tbl), CrWS.Cells(3, lastCol)).ClearContents For Each WS In ThisWorkbook.Sheets If WS.Name <> CrWS.Name Then CrWS.Cells(3, Tbl).Value = WS.Name Tbl = Tbl + 1 End If Next WS End Sub

أخي @algammal ربما ما لم تلاحظه هو أن القيم تعبأ على عناصر الكومبوبوكس مع تجاهل الفراغات والتكرارات ولهذا السبب تظهر معك مرة واحدة فقط وذلك لأن أرقام التسلسل الموجودة على ورقة معاشات هي نفسها الموجودة على الـ DATA ما يهمنا هنا هو جلب جميع البيانات المتوفرة على الورقتين التي تتضمن شروط التصفية المختارة وهذا واضح من خلال الإحصائيات أسفله وللتوضيح أكثر دعنا نجرب إضافة تسلسل جديد على ورقة المعاشات غير موجود مسبقا في DATA ونرى كيف سيتم التعامل معه لاحظ معي عند اختيار رقم التسلسل 1 الاحصائيات لدينا تظهر عدد الموظفين 2 على ورقة معاشات 1 وورقة DATA 1 أرفق لك آخر تحديث للملف توحيد البحث في شيت واحد v6.xlsb

السلام عليكم ورحمة الله وبركاته انا مش مصدق نفسى والله ولا كنت اتخيل ان فى احد الايام التقى بحضرتك يا استاذ @منتصر الانسي انا اول لما بدات اتعلم حضرتك موضوعاتك كانت من اهم الدعائم والركائز الاساسية التى اعتمدت عليها بعد رب العزة سبحانه وتعالى صدقنى كل كلمات الشكر تقف عاجزة امام عظمة ما قدمتموه وبذلتموه انتم وكل اساتذتى العظماء شكر الله لكم واحسن اليكم وجزاكم عنى وعن كل طلاب العلم كل الخير كل عام وانتم بخير وكل عام وانتم الى الله تعالى اقرب وعلى طاعته ادوم

عودا حميدا استاذنا ومعلمنا منتصر الآنسي ادام الله عليك النعم ومتعك متاعا حسنا في بدنك ومالك وولدك

شكرا جزيلا استاذ @عبدالله بشير عبدالله الله يحفظك

استبدل علامة (,) بتلك (;) في حال لم يتم التطبيق على المعادلة

في حدث تحميل او فتح : النموذج / التقرير اكتب Me.picture= "مسار الكليشة" على اعتبار الكليشة ستكون خلفية للخطاب

طيب اولا كان فى مشكلة فى الموضوع ولذلك تم التعديل للموضوع والمرفق تم تلافى الاخطأء والمشاكل وتم التجربة والتأكد من الاضافة والتأكد من الاتصال بالجهاز على شبكة محلية نعم استاذى القدير واخى الحبيب انت فاهم صح يتم اضافة وتخزين البيانات التى يتم تمريرها من خلال الأكواد الى : Windows Credentials الكود لا يقرئها من أعدادت الويندوز لأن أساس الفكرة وهذا الموضوع هى لو أن البيانات الخاصة بالاعتماد للارتباط والاتصال بجهاز السيرفر الذى يحتوى على المجلد الشبكى الذى تتم مشاركته لقاعدة البيانات الخلفية - عند نقل القاعدة الامامية لاى جهاز جديد على نفس الشبكة - أو محاولة فتح القاعدة على أى جهاز على نفس الشبكة تم اعادة تنصيب ويندوز له ولم يتم اضافة بيانات الاعتماد للاتصال بالسيرفر - او اى جهاز على نفس الشبكة كان به خلل فى حفظ بيانات الاعتماد للاتصال بالجهاز السيرفر يتم اضافة وتخزين البيانات عند فتح القاعدة الامامية من اول نموذج قبل محاولة الاتصال بجداول القاعدة الخلفية او ربط/إعادة ربط الجداول

السلام عليكم ورحمة الله وبركاته عذرا لتأخرى في الرد حسب الصورة المرفقة مع ردكم الكريم اظافة عنصر فارغ في القائمة e5 وبناء عليه تكون b10&g10 فارغتان تم التعديل و يمكنك تعديل نطاق القائمة كما تشاء يمكنك الاسنغناء عن زر انقر هنا للبحث وإذا لاحظت أي شيء يحتاج تعديل أو عندك أي فكرة تحب نضيفها، أنا حاضر بأي وقت، لك كل الود والتقدير طريقة اخرى للبحث معدلة6.xlsb

السلام عليكم ورحمه الله وبركاته ممكن تشاهد الرابط ادناه لعله يفيدك

وعليكم السلام ورحمة الله وبركاته اليك الكود المتاسب لطلبك Sub call1() Sheets("ff").Range("D3:U3").ClearContents Dim i As Integer For i = 1 To Sheets.Count Sheets("ff").Cells(3, 3 + i) = Sheets(i).Name Next i End Sub

السلام عليكم ورحمه الله وبركاته شاهد الموضوع ادناه لعله يكون المطلوب تجميع و دمج عده ملفات عمل اكسيل في ملف عمل واحد - منتدى الاكسيل Excel - أوفيسنا

السلام عليكم ورحمه الله وبركاته اتفضل لعله المطلوب Book1.xlsm

السلام عليكم ورحمه الله وبركاته ممكن تستخدم الكود التالي عند ظهور الاخطاء الخاصه من 32 الي 64 Private Declare Function استبدلها الي Private Declare PtrSafe Function ----------------------------------------------------------------- Private Declare استبدلها الي Private Declare PtrSafe

وعليكم السلام ورحمة الله تعالى وبركاته إذن أخي الكريم على الأقل قم بإرفاق ملفك وبه الأكواد المطلوبة مع ذكر النواة التي تستخدمها حاليا هل هي 32 أو 64 لتوضيح ما يظهر معك من أخطاء عند محاولة تنفيذ الكود لا يمكن العمل على التخمين !!!

انا آسف لمشاركتك الموضوع ، حاولت أوضحلك الفكرة أن ما فيش كود يقدر يحل مشكلتك بالبساطة اللي انت متخيلها . تحويل الأكواد دي بحر وااااسع ومش بكود بسيط تقدر تمشي أي كود على النواتين 32 و 64 . شكراً لك ، وأعتذر عن مشاركتي السابقة اللي انت ما استفدتش منها حاجة .

وعليكم السلام ورحمة الله وبركاته .. راجع هذا الموضوع ، عله يفيدك ، مع العلم أن الأداة قيد التطوير والتحديث

مشاركة مع زملائي واحبتي تفضل استاذ @عاشق_الرقي محاولتي حسب مافهمت . نموذج تغيير الشعارات (frm_Logos) وكيفية استدعائهم بالنموذج (frm_Office_Data) والتقرير (Rpt_OfficeData). تفضل المرفق واذا حابب أي شئ زيادة انا حاضر . DDCompanyLogos.rar

طبعا طريقتي لا تختلف عن ما ذكره الإخوة المهندسين الأعزاء 🙂 ولكن لدي صورة للنموذج الذي أستخدمه لضبط هذه الإعدادات : والذي يستند بطبيعة الحال إلى جدول خاص بحفظ هذه البيانات يحتوي على سجل واحد فقط .. ومن ثم قمت يعمل موديول وبه عدة إجرائيات تقوم باختصار المسافة علي لاستدعاء هذه البيانات في أي مكان بالبرنامج .. مثال : Public Function AppSett_OrganizationName() As String ' اسم المؤسسة AppSett_OrganizationName = Nz(DLookup("OrganizationName", "[AppSettingesT]"), "") End Function Public Function AppSett_OrgBranch() As String ' الفرع AppSett_OrgBranch = Nz(DLookup("OrgBranch", "[AppSettingesT]"), "") End Function Public Function AppSett_Org_Adress() As String ' عنوان المؤسسة AppSett_Org_Adress = Nz(DLookup("Org_Adress", "[AppSettingesT]"), "") End Function Public Function AppSett_Show_Adress_In_Reports() As Boolean ' إظهار العنوان في التقارير AppSett_Show_Adress_In_Reports = Nz(DLookup("Show_Adress_In_Reports", "[AppSettingesT]"), 0) End Function Public Function AppSett_OrganizationLogoPath() As String ' رابط الشعار الأول AppSett_OrganizationLogoPath = Nz(DLookup("OrganizationLogoPath", "[AppSettingesT]"), "") End Function Public Function AppSett_OrganizationLogoPath2() As String ' رابط الشعار الثاني AppSett_OrganizationLogoPath2 = Nz(DLookup("[OrganizationLogoPath2]", "[AppSettingesT]"), "") End Function فلو أردت استدعاء رابط الشعار الأول في التقرير مثلا .. أعمل مربع صورة وأجعل مصدر بياناته كالتالي : = AppSett_OrganizationLogoPath() ولو بغيت أظهر عنوان المؤسسة في التقرير أعمل مربع نص وأخلي مصدر بياناته : = AppSett_Org_Adress() وسلامتكم 🙂🖐

تفضل جرب هدا Option Explicit Sub Convert_Arabic() Dim WS As Worksheet, OnRng As Range, ky As Range Dim i As Integer, j As Integer, NumArr As Variant, tmp As Variant Dim val As String, c As String, newVal As String, n As Boolean NumArr = Array(ChrW(1632), ChrW(1633), ChrW(1634), ChrW(1635), _ ChrW(1636), ChrW(1637), ChrW(1638), ChrW(1639), ChrW(1640), ChrW(1641)) tmp = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9") Set WS = Sheets("Sheet1") Set OnRng = WS.UsedRange Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.ErrorCheckingOptions.BackgroundChecking = False For Each ky In OnRng If Not IsEmpty(ky.Value) And Not ky.HasFormula Then val = Trim(ky.Text): newVal = "": n = False If val Like "*[" & Join(NumArr, "") & "]*" Then GoTo SubApp If Right(val, 1) = "%" Then n = True: val = Left(val, Len(val) - 1) For i = 1 To Len(val) c = Mid(val, i, 1) If c Like "[0-9]" Then newVal = newVal & NumArr(CInt(c)) Else newVal = newVal & c End If Next i If n Then newVal = newVal & "%" ky.NumberFormat = "@": ky.Value = newVal End If SubApp: Next ky Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub أو يمكنك التنقل بينها على الشكل التالي تحويل الورقة بالكامل الى لغة عربية دون تغير لغة الجهاز -v2 .xlsb

وعليكم السلام ورحمة الله تعالى وبركاته بعد معاينة الملف لاحظت وجود أرقام بتنسيقات مختلفة هل تقصد تحويلها الى العربية مثلا ٨-٣ = 3-8 ٢/٣ = 2/3 ٢٣ = 23 ١٦/٠٤/٢٠٢٥ = 16/04/2025

بارك الله فى الجميع

يالا ياعم هيجوزك اهو شاكلنا معدناش شايفينك ههههههه الحكومه هتسجنك فى البيت مع ايقاف الكمبيوتر ههههههههههه

وجزيت خيراً أخي الكريم رضا على دعواتك الطيبة .. ولك بمثل إن شاء الله بس هحاول إني أخبي الدعاء بتاعك عشان الحكومة ممكن تاخدني مخالفة (الحكومة الأولى الجزء الخاص بزواج الأبكار .. والحكومة التانية الجزء الخاص بالجيوش) تقبل وافر تقديري واحترامي

جزاك الله خيرا و اطعمك طيرا و تزوجت ابكارا و انجبت جيوشا ...

أخي الكريم رضا وعليكم السلام ورحمة الله وبركاته جرب الخطوات التالية في الصور ----------------------------------