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

وعليكم السلام 🙂 من الطبيعي انك لا تستطيع ان تحذف اي ملف ، ما دام هناك برنامج فاتح الملف 🙂 فالطريقة الصحيحة هي ، اغلاق البرنامج ، ثم حذف الملف 🙂 هنا رابط يخبرك كيف تستطيع اغلاق برنامج : جعفر

السلام عليكم 🙂 صحيح ان الاستاذ احمد اعطاك الحل لبرنامجك ، ولكنك لن تستطيع استعمال هذا البرنامج على الكمبيوترات الاخرى !! الحل الصحيح كما هو في مشاركة الاستاذ احمد الثانية : جعفر

وعليكم السلام ورحمة الله وبركاته تستطيع انشاء حقل جديد في الاستعلام يحول البيانات في مربع النص الى رقم بهذا الشكل Expr1: IIf([TextField] Is Null, 0, Val([TextField]))

تفضل الكريم سيتم اظهار اخر دورتين فقط db1.accdb

أهلا بالجميع.. أهلا أ. @صالح حمادي ... أ. @رمهان يتعمد احراجي دائما.. الروابط في صفحة الويب لها تابع الروابط (Links) يمكن استهدافه والتعديل على خصائصه.. الرابط له خصيصة تدعى الهدف (TARGET) هي التي تتحكم في وجة الرابط.. يمكن التعرف عليها من الرابط التالي Anchor target Property الشفرة التالية تقوم بتغيير قيمة الخصيصة للفتح في الداخل.. Private Sub WebBrowser0_DocumentComplete(ByVal pDisp As Object, URL As Variant) Dim WD As Object Set WD = Me.WebBrowser0.Document For I = 0 To WD.links.length - 1 WD.links(I).Target = "_self" '//WD.links(I).Target = "_blank" Next End Sub يمكن التبديل مع السطر المعطل لمعرفة الفرق.. :: للفائد.. النماذج لها نفس الأسلوب مع التابع (Forms) :: المثال.. ويب.accdb

بعذ اذن الاخ علي وزيادة في اثراء الموضوع هذا الكود Option Explicit Sub Insert_rows() Dim lra%, i%, k% Dim dic As Object, Itm lra = Cells(Rows.Count, 1).End(3).Row On Error Resume Next Range("A1:A" & lra).SpecialCells(xlCellTypeBlanks). _ EntireRow.Delete On Error GoTo 0 lra = Cells(Rows.Count, 1).End(3).Row Set dic = CreateObject("Scripting.dictionary") For i = 1 To lra dic(Range("A" & i).Value) = _ Range("A" & i).Row Next For Each Itm In dic.items Rows(Itm + 1 + k).Insert k = k + 1 Next End Sub الملف مرفق Insert_Ro.xlsm

وعليكم السلام 🙂 من هذا الرابط وجدت الحل : https://www.mrexcel.com/board/threads/vba-code-to-print-pdf-file-from-adobe-reader-dc.939945/ يكون الكود هكذا Shell "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe /p /h " & LocalFileName, vbHide بحيث يكون اسم ملفك ومساره هو المتغير LocalFileName جعفر

السلام عليكم 🙂 ولكن وبما انه لا يمكن تغيير اسم الجدول/الحقل الذي به مسافة بين كلماته ، فالطريقة هي وضغ اسم الحقل/الجدول بين قوسين مربعين [] ، هكذا: Set Rs = db.OpenRecordset("SELECT * FROM [student Table]") جعفر

شكر الله لك .. نعم هذا هو المطلوب ..

السلام عليكم تقضل ان شاء الله يكون المطلوب 'يمكن استخدام الكود التالي (Is Null) للدلالة على الحقل الفارغ' If IsNull(Me.XVisitorName) Then 'اسم الزائر MsgBox "فضلا أدخل اسم الزائر" Me.XVisitorName.SetFocus Exit Sub ElseIf IsNull(Me.XVisitorDay) Then 'اليوم MsgBox "فضلا أدخل اليوم" Me.XVisitorDay.SetFocus Exit Sub ElseIf IsNull(Me.XVisitorDate) Then 'التاريخ MsgBox "فضلا أدخل تاريخ الزيارة" Me.XVisitorDate.SetFocus Exit Sub ElseIf IsNull(Me.XVisitorTaime) Then 'الوقت MsgBox "فضلا أدخل وقت الزيارة" Me.XVisitorTaime.SetFocus Exit Sub ElseIf IsNull(Me.XTarget) Then 'سبب الزيارة MsgBox "فضلا أدخل سبب الزيارة" Me.XTarget.SetFocus Exit Sub End If Database4.rar Database5.rar

كل الاحترام والتقدير عزيزي استمر تحياتي

اشكركم توصلت للحل

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

وعليكم السلام-تفضل تم عمل المطلوب بمعادلات الصفيف بعد ضبط تسمية صفحات الملف برنامج التنسيق 1.xlsm

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم On Error Resume Next Dim X As Integer mySQL = "Select * From tbl1" ' اذا كان TextBox رقم mySQL = mySQL & " WHERE TName = " & Me.TextBox ' اذا كان TextBox نوعه نصي ' mySQL = mySQL & " WHERE TName ='" & Me.TextBox & "'" Debug.Print mySQL Set rst = CurrentDb.OpenRecordset(mySQL) X = rst!TName If X <> 0 Then MsgBox "OK" Else MsgBox "No" End If تحياتي

في هذه الحالة شيت Source هي شيت المصدر و شيت Salim هي شيت النتيجة الكود اللازم Option Explicit Dim My_rgA As Range, My_rgB As Range Dim r% '++++++++++++++++++++++++++++++++++ Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Set My_rgA = Sheets("Source").Range("A2", Sheets("Source").Range("A1").End(4)) Set My_rgB = Sheets("Source").Range("B2", Sheets("Source").Range("B1").End(4)) If Target.Cells.Count = 1 Then Select Case Target.Address Case "$E$3": get_valB Case "$F$3": get_valA End Select End If Application.EnableEvents = True End Sub '++++++++++++++++++++++++++++++++++++++ Sub get_valB() If Application.CountIf(My_rgA, Range("E3")) Then r = My_rgA.Find(Range("E3"), lookat:=1).Row If r <> 0 Then Range("F3") = My_rgB.Cells(r - 1) Else Range("F3") = IIf(Range("E3") = "", "", "Not Found") End If End Sub '+++++++++++++++++++++++++++++++++++++ Sub get_valA() If Application.CountIf(My_rgB, Range("F3")) Then r = My_rgB.Find(Range("F3"), lookat:=1).Row If r <> 0 Then Range("E3") = My_rgA.Cells(r - 1) Else Range("E3") = IIf(Range("F3") = "", "", "Not Found") End If End Sub الملف الجديد Double_formula 2 Sheets.xlsm

تفضل اخى الكريم يمكنك استخدام هذه المعادلة =SUM(INT((WEEKDAY(A2-{2,3,4,5,6})+B2-A2)/7))-1 1معادلة لطرح التاريخ والوقت معا مع عدم احتساب ايام الاجازات.xlsx

بالضبط كما تفضلت والقصد من استعلام مؤقت هو تعبير مجازي فقط اي ان الاستعلام غير مرئي هو استعلام عادي جداً

السلام عليكم تفضل ما طلبته... والتعديل بسيط جدا.. بن علية حاجي 22 (2).xlsm

اتفضل استاذى الفاضل استبدل علامه * بـ % تم الحل بواسطه البحث بجوجل عالسريع Though it's not actually listed on official lists of Reserved words (I'd suggest that's an oversight) Alike is indeed a keyword in Jet SQL. It's the ANSI Like - which can be used in either mode of compatibility. In other words - when you're using Alike you would use the ANSI wildcard (%) instead of Jet's default (*). So WHERE FieldName Like 'Smith*' would be WHERE FieldName ALike 'Smith%' The behaviour you're seeing (Like automatically changed to Alike in the QBE - I presume it's the QBE - it wouldn't happen in SQL view.. the parser isn't that pushy) implies that you have your application in ANSI mode. (Whereby it assumes you want to use Alike). In fact - in that mode WHERE FieldName Like 'Smith%' would be valid syntax anyway. It's just going for maximum compatilbility in query writing. To remove it: Tools > Options > Tables/Queries > SQL Server Compatible Syntax (ANSI 92) Knock off the checkbox. Cheers. ALike "%" & [Forms]![نموذج1]![texs] & "%" تقبل تحياتى طبتم واهتديتم Database7.rar

الخبراء الافاضل هل ممكن مساعدتي فيما يلي : عند فتح نموذج تنبيه واختيار اي اسم من القائمة يظهر الصف عبارة عن رقم وتظهر الشعبة كرقم وما اريده ان تظهر مثلا ( العاشر ب ) بدلا من ( 10 ) ( 2 ) ولكم جزيل الشكر مع توضيح كيف تم عمل ذلك مع احترامي الشديد مثال.accdb

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

ما أقصده؛ لماذا تريد فتح صفحات الويب داخل Web Browser Object .. أريد أن أوضح هنا أن الحدث Document_Complete لا يقع إلا مرة واحدة عند اكتمال فتح الصفحة التي تم استدعاها عن طريق الإجراء Navigate. وللتخلص من هذه الإشكالية يمكن استخدام الحدث Download_Complete

عملت لك طريقة احترافية للبحث ............. تختار الاسم من القائمة المنسدلة ثم تكبس على ابحث شاهد الصورة المرفقة مثال (1).accdb

جزيت خيرا ..

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

اخي الكريم كل شيء ظاهر بالتقرير فقط قم باضافة المصاريف الادارية

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

تفضل لك ما طلبت Sub t() Dim i, itotalrows As Integer Dim strRange As Range, strRange2 As Range Dim col As Long itotalrows = ActiveSheet.Range("a65536").End(xlUp).Offset(1, 0).Row For col = 1 To 1 Do While i <= itotalrows i = i + 1 Set strRange = Cells(i, col) Set strRange2 = Cells(i + 1, col) If strRange.Text <> strRange2.Text Then Rows(i + 1).EntireRow.Insert itotalrows = ActiveSheet.Range("a65536").End(xlUp).Offset(1, 0).Row i = i + 1 End If Loop Next col End Sub وهذا كود اخر اصغر Sub InsertBlankRows() Dim LastRow As Long Dim i As Long LastRow = Cells(Rows.Count, "A").End(xlUp).Row For i = LastRow To 2 Step -1 If i = 1 Then 'Do nothing ElseIf Cells(i, "A") <> Cells(i - 1, "A") Then Cells(i, "A").Insert End If Next i End Sub ادراج 1صفوف.xlsm

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

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

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

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

الشكر لله اخي

أستاذ الارجواني أين الضغط على الإعجاب ؟!!

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

أستاذ hassan rady أين الضغط على الإعجاب ؟!!!

تحت أمرك وكلنا نتعلم في هذا المنتدى تم التعديل Entry form (2).xlsb

بارك الله فيك أستاذنا الفاضل حسين مأمون وبعد إذنك تم التعديل على التكست بوكس التكست بوكس عند الكتابة لا يزيد عن 10 أرقام وتم عمل شرط لو كُتِبَ رقم أقل من 10 أرقام بعد الانتقال منه يتم حذف الأرقام التي كانت خطأ وبالتالي يتم كتابة الرقم من جديد Entry form (2).xlsb

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

مثالين آخر ين للتقويم لاحد الاخوة التقويم.rar NA_Calendar2000-1.rar

هذه هى النتيجة 03:00 pm وليست 02:30 لا يوجد خطوات فقط اجعل تنسيق خلية الناتج كوقت وذلك كما بالصورة جمع ساعات 1العمل.xlsx

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

اخى الفاضل الامير هشام ارجو منك فضلا لا امرا بعد ذلك وضع مثال لما لديك من مشكله وشرح ما تريد حتى يتثنى لاخوانك واساتذتنا رؤيه المشكله وحلها ارفق لك مثال من مكتبتى وجزاه الله خيرا ابو هاجر وربنا يجعله فى موازين حسناته ان شاء الله ارجو ان لا تغضب من كلام اخيك المبتدأ احمد تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق طبتم واهتديتم Calendar2K.mdb وهذا مثال اخر لااذكر من اين قمت بتحميله ولكنه محكوم بداخل النموذج ادراج تاريخ من calender.rar

بارك الله فيك انت عرضت السؤال وانت وضعت الحل ايضا بالطريقة التي ذكرتها يتم تحقيق ذلك If Dir(CurrentProject.Path & "\Pic", vbDirectory) <> "" Then SetAttr (CurrentProject.Path & "\Pic"), vbHidden ElseIf Dir(CurrentProject.Path & "\Pic", vbDirectory) = "" Then MsgBox "لا يوجد ملف حتى يتم التطبيق " SetAttr (CurrentProject.Path & "\Pic"), vbNormal

احسنت سيد جعفر...😘

جرب الان بس انا مافهمت بخصوص التقرير الاخضر انت ترغب يطبع السجل الحالي او كافة انا عملته يطبع الحالي وبامكانك تعديلة الى كافة السجلات من خلال الدخول على مصدر التقرير وحذف المعيار من الحقل الاول Permit to Work.rar

استبدل المعادلة بهذه

االله يعطيك الف الف عافيه جميل جدا وفعلا اشتغل و 100%

وعليكم السلام تقدر تستخدم هذا الكود: Private Sub Command1_Click() TerminateProcess ("calc.exe") End Sub Private Sub TerminateProcess(app_exe As String) Dim Process As Object For Each Process In GetObject("winmgmts:").ExecQuery("Select Name from Win32_Process Where Name = '" & app_exe & "'") Process.Terminate Next End Sub واذا ما فادك ، استعمل الكود من هنا: http://www.vbforums.com/showthread.php?318582-Terminating-Running-EXE&p=1878673#post1878673 جعفر