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

احبتي حتى لا أطيل في الشرح و بدون مقدمات قصتي تتضح من عنواني و نبدء الآن ... انشئ Module جديد و اضف الكود التالي Option Explicit Public Function Translate(strInput As String, strFromSourceLanguage As String, strToTargetLanguage As String) As String Dim strURL As String Dim objHTTP As Object Dim objHTML As Object Dim objDivs As Object, objDiv As Object Dim strTranslated As String strURL = "https://translate.google.com/m?hl=" & strFromSourceLanguage & _ "&sl=" & strFromSourceLanguage & _ "&tl=" & strToTargetLanguage & _ "&ie=UTF-8&prev=_m&q=" & strInput Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP") 'late binding objHTTP.Open "GET", strURL, False objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)" objHTTP.send "" Set objHTML = CreateObject("htmlfile") With objHTML .Open .Write objHTTP.responsetext .Close End With Set objDivs = objHTML.getElementsByTagName("div") For Each objDiv In objDivs If objDiv.className = "t0" Then strTranslated = objDiv.innerText Translate = strTranslated End If Next objDiv Set objHTML = Nothing Set objHTTP = Nothing End Function ثم يمكن تجربة هذه الشفرة الخاصة بتغيير لغة العرض بالطريقة التالية MsgBox Translate("اهلا و سهلا", "ar", "en") مرفق مثال تطبيقي على ما ورد اعلاه و دمتم في رعاية الله و حفظه ... . Data.mdb

وعليكم السلام-فقط عليك استخدام هذه المعادلة لتاريخ البداية =DATE(C3,B3,A3) وهذه لتاريخ النهاية =DATE(F3,E3,D3) Date1.xlsx

وعليكم السلام اخى الفاضل لدمج حقول مع بعضها نستخدم هذه الطريقه ولوضع اى شىء بينهم يكون بعد & وبين علامات التنصيص [text1] & "/" & [text2] & "/" & [text3] بالتوفيق

وعليكم السلام -يمكنك هذا بمعادلة المصفوفة =IFERROR(INDEX(Mapping!$A$2:$A$178,SMALL(IF(Mapping!$B$2:$B$178=$A$4,ROW(A$2:A$178)-ROW(A$2)+1),ROWS($A$6:A6))),"") Rank Country.xlsm

كان عليك توضيح هذا الطلب من البداية تجنباً لعدم اهدار الوقت -تفضل يمكنك هذا بذلك الكود Private Sub CommandButton1_Click() On Error Resume Next Dim ws As Worksheet Set ws = Sheets("Sheet1") Me.TextBox2.Value = Me.TextBox1.Value * WorksheetFunction.VLookup(Me.ComboBox1.Value, ws.Range("a2:d20"), 2, 0) Me.TextBox3.Value = Me.TextBox1.Value * WorksheetFunction.VLookup(Me.ComboBox1.Value, ws.Range("a2:d20"), 3, 0) Me.TextBox4.Value = Me.TextBox1.Value * WorksheetFunction.VLookup(Me.ComboBox1.Value, ws.Range("a2:d20"), 4, 0) End Sub 2حساب النسبة المئوية.xlsm

السلام عليكم تم عمل ترقية جديدة للمنتدى الان اذا واجهتك مشاكل بعد التحديث يرحى افراغ الكاش من المتصفح مثلا فى جوجل كروم او ختصارا CTR+Shift+DEL

حبيبي استاذ احمد دائما متواضع

ولا يهمك اخى ازهر والافضل اجابه اخى العزيز حسام بالتوفيق

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

السلام عليكم مشاركة مع اخي واستاذي الفلاحجي Private Sub idserum_AfterUpdate() Me.z = Me.x * Me.y Forms!Fexperience.Refresh Forms!Fexperience!xy = Forms!Fexperience!m End Sub

السلام عليكم اخى @ازهر عبد العزيز اتفضل اخى ازهر بعد محاولات الردود وجزاه الله خيرا مهندسنا الغالى @محمد طاهر وجميع القائمين على الموقع وتطويره كان هناك مشكله وان شاء الله تكون قد انحلت لدى الجميع ان صادفتهم جرب ووافنى بالنتيجه بعد الاختيار من النموذج الفرعى من الكمبو idserum Private Sub idserum_AfterUpdate() Me.z = Me.x * Me.y DoCmd.RunCommand acCmdSaveRecord Forms!Fexperience.SetFocus Forms!Fexperience!m = IIf([idexperience] <> "", Nz(DSum("z", "Qtest", "idexperience=" & [idexperience]), 0), 0) Forms!Fexperience!xy = Forms!Fexperience!m End Sub بالتوفيق اخى test(4).accdb

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

اخي الكريم الطريقة التي تستخدمها جدا مجهدة ماذا لو أردت مستقبل اضافة لغة أخرى هل ستعيد بناء الكود من جديد ؟؟ 💡 اقتراح استخدم خدمة translate google فهي تحوي اغلب لغات العالم ان جازت لك الفكرة ستجد ادناه الطريقة للاستفادة منها انشئ Module جديد و اعطه اي اسم ترغب به و ثم اضف الكود التالي Option Explicit Public Function Translate(strInput As String, strFromSourceLanguage As String, strToTargetLanguage As String) As String Dim strURL As String Dim objHTTP As Object Dim objHTML As Object Dim objDivs As Object, objDiv As Object Dim strTranslated As String strURL = "https://translate.google.com/m?hl=" & strFromSourceLanguage & _ "&sl=" & strFromSourceLanguage & _ "&tl=" & strToTargetLanguage & _ "&ie=UTF-8&prev=_m&q=" & strInput Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP") 'late binding objHTTP.Open "GET", strURL, False objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)" objHTTP.send "" Set objHTML = CreateObject("htmlfile") With objHTML .Open .Write objHTTP.responsetext .Close End With 'Range("H1") = objHTTP.responsetext Set objDivs = objHTML.getElementsByTagName("div") For Each objDiv In objDivs If objDiv.className = "t0" Then strTranslated = objDiv.innerText Translate = strTranslated End If Next objDiv Set objHTML = Nothing Set objHTTP = Nothing End Function بعد ان اضفنا الشفرة الخاصة بجلب اللغة نبدء الأن باستدعاء تلك الشفرة بالطاريقة التالية في حدث ازرار اللغة ضغط كود استدعاء الشفرة اعلاء لاستبدال اللغة المدخلة الى اللغة التي تريدها ' رسالة للتجربة MsgBox Translate("اهلا و سهلا", "ar", "en") بهذه الطريقة تستطيع بناء جدول يحتوي على جميع اللغات التي تريدها و بكل بساطه تستطيع ان تجعل برنامج يخدم جميع لغات العالم تقبل مروري

وعليكم السلام-عليك التحلى بالصبر وكان عليك رفع ملف مصغر كنموذج وليس كل هذا الملف تفضل لك ما طلبت تم عمل قائمة منسدلة بأسماء المقاولين .... وأعتقد انه ليس هناك داعى لعمل صفحات مستقلة بأسماء المقاولين لأن هذا سيثقل من حجم الملف ويبطئه , فقط عليك اختيار اسم المقاول من القائمة المنسدلة واترك الباقى على الإكسيل-بارك الله فيك حساب توريدات٢٠٢1.xlsx

أحسنت استاذ سليم عمل ممتاز بارك الله فيك وزادك الله من فضله

وعليكم السلام -يمكنك استخدام هذه المعادلة لطلبك =IF(ROWS($G$12:G12)>DAY(EOMONTH(DATE($O$3,$P$4,1),0)),"",DATE($O$3,$P$41,ROWS($G$12:G12))) كشف الحضور1.xlsm

وعليكم السلام-اهلا بك فى المنتدى - سيتم ما تطلب بهذا الكود Private Sub CommandButton1_Click() TextBox2.Value = (TextBox1.Value) * 0.8 TextBox3.Value = (TextBox1.Value) * 0.95 TextBox4.Value = (TextBox1.Value) * 1.14 End Sub 1حساب النسبة المئوية.xlsm

تفضل هذا الفيديو وتحته الملفات اللازمة لإضافة Date Picker .... للأستاذة ساجدة العزاوى وهذا فيديو لـــــــــ TreeView Intro to Excel TreeView Control | Excel Userform Tutorial

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

تفضل

هذا الملف بشرح ما أفصده 1-البيانات الاساسية في صفحة Salim 2- في الصفحة Result بعد تنفيذ الفلتر بواسطة UserForm يمكن احتيار اي صف من ListeBox لينتقل الى الشيت في المكان المناسب (يمكن تكرار العملية وفي كل مرة يضاف ما تحتاره الى احر صف) 3- الصورة المرفقة تشرح كيفية التعامل مع UserForm الملف مرفق Filter_By UserForm.xlsm

وعليكم السلام ورحمة الله وبركاته غير مسار حقظ التقرير من GetWinTemp الى CurrentProject.Path من PDF_Name_Path = GetWinTemp & "\ImitatePDFPrintingLikeInOracleButFromMsAccess.pdf" الى PDF_Name_Path = CurrentProject.Path & "\ImitatePDFPrintingLikeInOracleButFromMsAccess.pdf" تحياتي او قم بتعريف المتغير GetWinTemp اولا Public Function GetWinTemp() As String GetWinTemp = Environ("Temp") End Function

Private Sub idserum_AfterUpdate() Me.z = Me.x * Me.y Forms!Fexperience.Refresh Forms!Fexperience!xy = IIf([idexperience] <> "", Nz(DSum("z", "Qtest", "idexperience=" & [idexperience]), 0), 0) End Sub

تفضل اخي الكريم Dim Xid As Integer Xid = Nz(DMax("[Id]", "tbl_name"), 0) + 1 mySQL = "INSERT INTO tbl_name (id,student_name) Values ('" & Xid & "', '" & Me.xxx & "');" CurrentDb.Execute mySQL Me.student.Requery مدرسه جديد.rar تحياتي

احبك الله الذى احببتنى فيه 💐

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

شكرا جزيلا , الحمدلله انحلت المشكلة وجازاك الله كل الخير

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

وعليكم السلام-يمكنك هذا بهذه المعادلة =IFERROR(LOOKUP(2,1/(Export[Year]=$B$4),Export[Month]),"") Last Text1.xlsx

اكتب هذا الكود تحت حدث عند النقر للزر AAA Forms!Lab_All.SetFocus Forms!Lab_All!BBB.SetFocus

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

تجربتي انا اضع جدول للمشتريات وجدول فرعي اطراف مشتريات وجدول للمبيعات وفرعي اطراف مبيعات وفي كل منهما استخدم الترقيم التلقائي الخاصة باكسس ولكن باجراء تعديل لتكون فاتورة المبيعات الاولى تبدأ برقم 10000001 وفاتورة المشتريات برقم ايضا تلقائي بيبدأ بـ 20000001 الفواتير تحفظ تلقائيا بمجرد ادخالها ولكن الفاتورة تبقى غير منفذة الا بالنقر على زر حفظ حيث يتم اضهار نموذج السداد وبمجرد تنفيذ السداد يتم زيادة الكميات او انقاصها في جدول الكميات الخاص بالاصناف وتكون الفاتورة منفذة لايمكن الغائها او تعديلها الالغاء او تعديل الكميات يكون عن طريق شاشة المرتجع وهذا الامر مفيد بالنسبة لي لكون بعض العملاء يتراجع عن الشراء او يرغب في البحث عن اصناف اخرى وهنا يمكن تعليق الفاتورة و فتح فاتورة جديدة للعميل التالي وايضا لا يتغير كميات الاصناف الا للفواتير المنفذة وللتحديث استخدم جداول مؤقتة واستعلام يقوم بحساب الكمية المتوفرة وتنفيذ الزيادة او النقص حسب نوع العملية ولم يواجه مستخدمي الاصدارة الاخيرة بيتا4 اي مشكلة علما بان احد المستخدمين لديه اربعة موظفي كاشير وتصل عند الذروة الى 6 موظفين يعملوا عن طريق الشبكة للحصول على الترقيم التلقائي المنسق يمكن بعدة طرق من ابسطها عن طريق استعلام sql للمبيعات INSERT INTO invoices ( bil_number ) SELECT 10000001 AS Expr1; للمشتريات INSERT INTO invoices ( bil_number ) SELECT 20000001 AS Expr1; هذا الاستعلام ينفذ في بداية تشغيل القاعدة ثم يحذف ملاحظة مهمة عند حذف كافة الفواتير وعمل ضغط واصلاح للقاعدة فسوف يعود الترقيم الاساسي لاكسس من رقم 1 اما في حالة وجود فواتير مسجلة فلن يكون هناك اي مشكلة مع الضغط والاصلاح

هذه تعملها كما تعمل معيار بين تاريخين: في الاستعلام ، في حقل رقم امر الصرف ، اكتب في المعيار : >=Forms!frm_Main!From_A and <=Forms!frm_Main!To_A ويكون عندك في النموذج frm_Main ، حقلي ، من امر صرف: From_A ، والى امر صرف: To_A جعفر

تعديل التعديل تحويل الدقائق (1).xls

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

بعذ اذن احي أحمد بدرة اختر الغام المناسب من الخلية G1 MH332.xls

وعليكم السلام ورحمة الله وبركاتة اخي انت لم تهتم بالعلاقات وهذا الخطا الذي وقعت فية الاكسس يتميز بالعلاقات جرب هذة المحاولة مني لعلي وفقت بالمساعدة مثال.accdb

جرب هذا تغير التاريخ.xls

وعليكم السلام 🙂 نريد نعمل تجميع وهمي : . . . ونعطيه اي اسم خرافي ، مثلا نقطة (.) . . . . والنتيجة . جعفر 1266.قائمة.accdb.zip

يمكن تجربة هذا الملف YARA_2_USERS..xlsm

وعليكم السلام-تفضل فيروس الفدية وهذا رابط خارجى ازالة فيروس الفدية في 9 خطوات وفك تشفير الملفات بدون فورمات وهذا فيديو أيضاً للشرح

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

تفضل هذا الفيديو سيفيدك فى طلبك

Alien فين انت من هذه الإجابة الممتازة ؟!!! أين الضغط على الإعــــــجــــــاب ؟!!!💙

Try his file Code_Number.xlsx

جرب هذا الملف Shaal.xlsm

السلام عليكم رمضان كريم على الجميع وجدة هذا الكود الخاص بتفعيل عجلة الماوس لليست بوكس كما وجدة بأنه يعمل كذلك مع الكومبو بوكس فأردت مشاركته اياكم لتعميم الفائدة وانا بصراحة اعجبني حيث انه يصبح من السهل تصفح البينات خاصتا عندما تكون كبيرة كل ما عليكم وضع هذا الكود في موديل عادي Option Explicit Private Type POINTAPI X As Long Y As Long End Type Private Type MOUSEHOOKSTRUCT pt As POINTAPI hwnd As Long wHitTestCode As Long dwExtraInfo As Long End Type Private Declare Function FindWindow Lib "user32" _ Alias "FindWindowA" ( _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Private Declare Function GetWindowLong Lib "user32.dll" _ Alias "GetWindowLongA" ( _ ByVal hwnd As Long, _ ByVal nIndex As Long) As Long Private Declare Function SetWindowsHookEx Lib "user32" _ Alias "SetWindowsHookExA" ( _ ByVal idHook As Long, _ ByVal lpfn As Long, _ ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare Function CallNextHookEx Lib "user32" ( _ ByVal hHook As Long, _ ByVal nCode As Long, _ ByVal wParam As Long, _ lParam As Any) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" ( _ ByVal hHook As Long) As Long Private Declare Function WindowFromPoint Lib "user32" ( _ ByVal xPoint As Long, _ ByVal yPoint As Long) As Long Private Declare Function GetCursorPos Lib "user32.dll" ( _ ByRef lpPoint As POINTAPI) As Long Private Const WH_MOUSE_LL As Long = 14 Private Const WM_MOUSEWHEEL As Long = &H20A Private Const HC_ACTION As Long = 0 Private Const GWL_HINSTANCE As Long = (-6) Private mLngMouseHook As Long Private mListBoxHwnd As Long Private mbHook As Boolean Private mCtl As MSForms.Control Dim n As Long Sub HookListBoxScroll(frm As Object, ctl As MSForms.Control) Dim lngAppInst As Long Dim hwndUnderCursor As Long Dim tPT As POINTAPI GetCursorPos tPT hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y) If Not frm.ActiveControl Is ctl Then ctl.SetFocus End If If mListBoxHwnd <> hwndUnderCursor Then UnhookListBoxScroll Set mCtl = ctl mListBoxHwnd = hwndUnderCursor lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE) If Not mbHook Then mLngMouseHook = SetWindowsHookEx( _ WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0) mbHook = mLngMouseHook <> 0 End If End If End Sub Sub UnhookListBoxScroll() If mbHook Then Set mCtl = Nothing UnhookWindowsHookEx mLngMouseHook mLngMouseHook = 0 mListBoxHwnd = 0 mbHook = False End If End Sub Private Function MouseProc( _ ByVal nCode As Long, ByVal wParam As Long, _ ByRef lParam As MOUSEHOOKSTRUCT) As Long Dim idx As Long On Error GoTo errH If (nCode = HC_ACTION) Then If WindowFromPoint(lParam.pt.X, lParam.pt.Y) = mListBoxHwnd Then If wParam = WM_MOUSEWHEEL Then MouseProc = True If lParam.hwnd > 0 Then idx = -1 Else idx = 1 idx = idx + mCtl.TopIndex If idx >= 0 Then mCtl.TopIndex = idx Exit Function End If Else UnhookListBoxScroll End If End If MouseProc = CallNextHookEx( _ mLngMouseHook, nCode, wParam, ByVal lParam) Exit Function errH: UnhookListBoxScroll End Function ثم في حدث MouseMove بالنسبة للكومبوبوكس ضع هذا الكود HookListBoxScroll Me, Me.ComboBox1 اما بالنسبة لليست بوكس في حدث MouseDown ضع هذا الكود HookListBoxScroll Me, Me.ListBox1 وفي الاخير في حدث UserForm_QueryClose ضع هذا الكود UnhookListBoxScroll ارجو ان يفيدكم الموضوع قبل الله صيام الجميع تفعيل عجلة الماوس.rar

وعليكم السلام مرحبا بكى فى المنتدى هناك العديد من البرامج منها: المرتبات.xls رواتب5.mdb المرتبات والاجور.xls وكذلك هناك برنامج مرتبات مرفوع على هذا الموقع https://www.mediafire.com/#myfiles

السلام عليكم المرفق به ما تريد كود منع الحفظ للاستاذ عمر الحسيني (ابوتامر) حفظه الله وكود منع النسخ واللصق من مشاركة للاستاذ بن علية كان لطلب لي انا === جرب المرفق منع النسخ واللصق ومنع حفظ بأسم.rar

السلام عليكم ورحمة الله والله أخي الكريم نحن في الخدمة ما اسطعنا لذلك سبيلا... إن الكود الذي وضع لطباعة الشهادات هو من أبسط الأكواد... تلاحظ أولا أن الشهادة استعملت فيها على الخصوص الدالة VLOOKUP أو RECHERCHEV التي تعتمد على قيمة الخلية B2 في ورقة "الشهادات" التي تمثل فيها "قيمة البحث" في قاعدة البيانات... والكود يقوم ببساطة بتغيير هذه القيمة تصاعديا من القيمة الموجودة في الخلية B1 (ووضعنا فيها 1) إلى القيمةالموجودة في الخلية C1 (التي وضعنا فيها القيمة الكبرى للعمود A:A من قاعدة البيانات للدلالة على آخر رقم للطلاب أو رقم الطالب الأخير في القائمة)... وكل ما يقوم هذا الكود بتغيير قيمة الخلية B2 يقوم مباشرة بطبع الشهادة المقابلة لهذه القيمة (وهي الرقم التسلسلي للطالب)... نلقي نظرة إلى الكود ونشرحه خطوة خطوة: Dim i As Integer إعلان لمتغير سميناه I Sheets("الشهادات").Select لفتح ورقة "الشهادات" المراد طبعها For i = Range("b1") To Range("c1") مجال تغيير قيمة المتغير I من قيمة الخلية B1 إلى قيمة الخلية C1 Range("b2") = i وضع قيمة I في الخلية B2 (التي تقوم بتغيير المعلومات في الشهادة بوساطة الدالة VLOOKUP) If i <= Range("c1") Then شرط مواصلة عمل الكود "إذا كانت قيمة I أصغر من أو تساوي مضمون الخلية C1 يقوم الكود بالخطوة التالية وإذا لم يكن يتوقف الكود End Sub) ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True الخطوة التي يقوم بها الكود إذا كان الشرط السابق محققا) وتتمثل في طباعة الشهادة End If توقف الكود عن الطباعة (مؤقتا) Next i تغيير قيمة I إلى القيمة الموالية ومواصلة عمل الكود بالطريقة نفسها (يغير ويطبع) إلى أن تصل قيمة I إلى قيمة الخلية C1 Sheets("إدخال").Select العودة إلى ورقة "إدخال" الورقة الرئيسية عند الانتهاء من طبع كل الشهادات End Sub أرجو أن يكون هذا الشرح مستوفيا... وليس عندي ما أقوله غير هذا... وأتمنى أن يصحح إخوتي من عباقرة المنتدى الأخطاء في شرحي أخوك دائما "بن علية"