كل الانشطه

تفضل تم التحسين على الملف بخصوص المشكلة الاولى المشكلة الثانية تم فصل الصفحات تكون كل صفحة 66 صف واضفت لك للتوضيح بداية كل صفحة يكون لون الخط في الصف بالاحمر عشان تنسق الصفحات إذا صار فيه لخبطة عندك والكود محسن ينفذ لك الامر خلال اقل من 8 ثواني Book1.rar

السلام عليكم ورحمة الله وبركاته جزاك الله خير بعد اذنك محتاج كلمة المرور

العنوان غير مطابق للمطلوب في الملف نرجو منكم الإلتزام بقوانين وسياسة المنتدى ، بحيث :- يكون العنوان ذات صلة واضحة للمطلوب . الشرح الوافي للمطلوب في المشاركة حتى لو اضطررت لكتابة 1000 سطر ، حتى تحصل على إجابتك بسرعة .

جرب هذا الملف بعد التعديل . حيث تم تعديل الكود ليصبح :- Option Explicit #If VBA7 Then Private Declare PtrSafe Function OpenProcessToken Lib "advapi32.dll" ( _ ByVal ProcessHandle As LongPtr, _ ByVal DesiredAccess As Long, _ ByRef TokenHandle As LongPtr _ ) As Long Private Declare PtrSafe Function GetTokenInformation Lib "advapi32.dll" ( _ ByVal TokenHandle As LongPtr, _ ByVal TokenInformationClass As Long, _ ByRef TokenInformation As Any, _ ByVal TokenInformationLength As Long, _ ByRef ReturnLength As Long _ ) As Long Private Declare PtrSafe Function GetCurrentProcess Lib "kernel32" () As LongPtr Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _ ByVal hwnd As LongPtr, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long _ ) As LongPtr #Else Private Declare Function OpenProcessToken Lib "advapi32.dll" ( _ ByVal ProcessHandle As Long, _ ByVal DesiredAccess As Long, _ ByRef TokenHandle As Long _ ) As Long Private Declare Function GetTokenInformation Lib "advapi32.dll" ( _ ByVal TokenHandle As Long, _ ByVal TokenInformationClass As Long, _ ByRef TokenInformation As Any, _ ByVal TokenInformationLength As Long, _ ByRef ReturnLength As Long _ ) As Long Private Declare Function GetCurrentProcess Lib "kernel32" () As Long Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _ ByVal hwnd As Long, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long _ ) As Long #End If Public Function IsRunAsAdmin() As Boolean Const TOKEN_QUERY As Long = &H8 Const TokenElevation As Long = 20 Dim hToken As LongPtr Dim elev As Long Dim retLen As Long If OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, hToken) <> 0 Then If GetTokenInformation(hToken, TokenElevation, elev, LenB(elev), retLen) <> 0 Then IsRunAsAdmin = (elev <> 0) End If End If End Function Public Sub RestartAsAdmin() Dim exePath As String Dim wbPath As String exePath = Application.Path & "\EXCEL.EXE" wbPath = """" & ThisWorkbook.FullName & """" ShellExecute 0, "runas", exePath, wbPath, vbNullString, 1 Application.Quit End Sub Public Sub CreateTextFile() Dim FilePath As String Dim FileNum As Integer If Not IsRunAsAdmin Then MsgBox ". (Administrator) البرنامج بحاجة إلى صلاحيات مسؤول" & vbCrLf & _ "... لطلب صلاحيات المسؤول Excel سيتم اعادة تشغيل", _ vbExclamation + vbMsgBoxRight, "تحتاج صلاحيات" RestartAsAdmin Exit Sub End If FilePath = "C:\Windows\fs.txt" FileNum = FreeFile Open FilePath For Output As #FileNum Print #FileNum, "https://www.officena.net/" Close #FileNum MsgBox "تم إنشاء الملف بنجاح في:" & vbCrLf & FilePath, _ vbInformation + vbMsgBoxRight, "نجاح" End Sub Book1.zip

تم إضافة التحديث الجديد في المشاركة الأولى

تحديث واستكمال 1- اضافة واجهة وازار 2- عند التحويل انشاء تلقائي جداول عند مسار الملف الصور المحول مع الربط الآلي 3- عرض والتقسيم بكود عام 4- اضافة اداوت التحكم بعد التحويل PDF الى صور 5- استخراج التقرير الى صور JPG Png ... 6- فتح اي تقرير للنافذة التقرير مع التقسيم دالة عامة + كود الاستدعاء داخل الزر -- للتجربة تحميل المرفق https://www.mediafire.com/file/k8qiz3dnjofr3wv/V_1_4_PDF_To_IMG_Trluoon.rar/file

بارك الله فيك أستاذ وجزاك الله خيرا

الجديد في هذا الاصدا ر بتاريخ15/8/2025 تعديل ترحيل التلاميذ بحيث الباقي والمنقطع لا يتم ترحيله ويبقى في صفه تجده باخر الصف تعديل احصاء الفصول بحيث يتم استدعاء الفصول الفعلية فقط عدم التقيد بعدد معين للفصول حتى اكثر من50 فصل تعديل فورم البحث بجزء من الاسم اضافة صفحة الباقون ويتم تعبئتها تلقائيا بعد الترحيل التحميل من هنا

الحمد لله توصلت لبعض الاكواد الرائعة ولتعميم الافادة إليكم الملف وبه 7 اكواد للنسخ وللنقل ومع الحفاظ على التنسيق وبدونه وايضا اضافة شرط رابع مع الحفاظ على ما تم نقله Book1 (1).rar

اساتذتي الغالين ... @Foksh @ابوخليل أولاً : أعتذر من الجميع عن تأخر ردي بسبب انشغالي وشكرا لكم على سرعة الرد ، حفظكم الله وزادكم الله نورا وعلما ينتفع به الناس ثانياً : أريد أن أنبه لنقطة مهمة أن الجدول الرئيسي InvHT يعتمد علية بشكل أساسي في جميع حركات المبالغ من (بيع وشراء واسناد القبض والصرف وصادر ووارد ..الخ) المدخلة والصادرة للصناديق ، وكذلك اعتمد علية بالدائن والمدين بشكل أدق في جميع الاستعلامات والتقارير فإذا تم عمل جدول فرعي لتحويل من صندوق لأخر فهذا سيكون غير دقيق وليس عملي في معرفة حركة المبالغ هل ممكن ان يتم الاعتماد على الجدول الرئيسي في الحركات تحويل المبلغ بين الصناديق والخ؟ وماهي الطريقة؟ أتمنى تطبيق الفكرة بشكل مباشر في الملف الذي قمت بأرفاقه لكم مع عمل نموذج بشكل فعلي في التحويل بين الصناديق شاكرا لكم على كل ماتبذلوه لنا من وقتكم وجهدكم الثمين علماُ : أن أسماء الجداول: boxsNames = الصناديق والبنوك CurrencysNames = العملات CustomersNames = العملاء InvHT = الجدول الرئيسي InvTT = الجدول الفرعي حركة الأصناف NameMovement = أنواع الحركات NamesTybes = نوع المستفيد من الحركة SuppliersNames = الموردين مرفق الملف: boxs-00.accdb

الأستاذ الفاضل hegazee الأستاذ الفاضل lionheart نعم هذا المطلوب لكم جزيل الشكر والتقدير

الاستاذ الفاضل وايلى حبيب .. ما شاء الله عمل رائع وممتع واسمح لى ببعض الكلمات اولاً الكشف الثانى غير مرتب فى التسلسل .. ثانياً غير ملتزم بالعدد المطلوب تقبل منى كل الشكر والتقدير وجزاك الله الف خير

للاسف استاذي الفاضل لايوجد خيار الرجوع للبدايه ولاكن انا رايت نفس الطابعه علي برامج اخري عند الطباعه مثلا طبعت فاتوره وبغد ذلك جيت اطبع فاتوره ثانيه من غير ما اقرب علي الطابعه ولا ولا اقطع الفاتوره الاولي اتوامتك ترحع للخلف وتظبط نفسها فسالت المستخدم قال لي احنا ما بنظبطش حاجه في اعدات الطابعه احنا بس بنسطبها فقط وتقريبا في مقاسات من داخل البرنامج وبرمجهونضع مقاسات في الطابعه

وفيك بارك الله تم التعديل Private Sub ComboBox1_Change() On Error Resume Next Application.EnableEvents = False Sheets("Sheet2").Range("L8").value = ComboBox1.value TextBox12.value = Sheets("Sheet2").Range("L10").value Application.EnableEvents = True On Error GoTo 0 End Sub Private Sub TextBox12_Change() Static lastValue As Variant On Error Resume Next Application.EnableEvents = False If IsNumeric(Me.TextBox12.value) Then Dim value As Integer value = CInt(Me.TextBox12.value) Dim minValue As Integer, maxValue As Integer, newValue As Integer If value >= 8 Then minValue = 0 maxValue = 40 Else minValue = 0 maxValue = 30 End If Randomize Do newValue = Int((maxValue - minValue + 1) * Rnd()) + minValue Loop While newValue = lastValue Me.TextBox3.value = newValue lastValue = newValue ThisWorkbook.Sheets("Sheet2").Range("L13").value = newValue End If Application.EnableEvents = True On Error GoTo 0 End Sub if أوفيسنا 3.xlsb

استاذنا الفاضل حاولت تجربة الكود في ملف الاكسل توقف منذ البداية واعطى خطأ في اول سطور اللي فيها #ة ممكن التوضيح

السلام عليكم اشكر اخواني المشاركين في الموضوع حبيت ارفق تجربتي البسيطة مع مساعدي الخاص واتمنى يكون هو المطلوب Book1.rar

بارك الله فيك أستاذ وجزاك الله خيرا لكن ليس هذا المطلوب ربما أنا اخطأت في شرح المطلوب العمل في الفورم المطلوب TextBox12 -1 اذا كان التكست بوكس 12أقل أويساوي 7 النقطة تكون ما بين 0 حتى 30 لا تقبل 31 -2اذا كان التكست بوكس12 أأكبر أويساوي 8 النقطة تكون ما بين 0 حتى 40 لا تقبل 41 النقطة في التكست بوكس 3 متغيرة TextBox3

الاجابة في المشاركة التالية

تمام كان الخطأ في كود اسم الورقة المفروض يكون www

اليك البرنامج تصدير.rar

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

الملف الصحيح العفو if أوفيسنا.xlsb السلام عليكم طلب مساعدة في دالة if الشرح في الملف المرفق fhvm hggi tdml if أوفيسنا 2.xlsb if أوفيسنا 2.xlsb

Try the file كود إخفاء واظهار شيتات محددة برقم سري والباقي ظهار.xlsm

أستاذي الفاضل / hegazee اشكر لك سرعة تفاعلك نفس المشكلة وجزاك الله خير

و عليكم السلام جرب الملف الرقم السري 1234 كود إخفاء واظهار شيتات محددة برقم سري والباقي ظهار 2.xlsm