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

♻ تم ضبط أسماء الملفات العربية عند الرفع . ♻ تم إضافة ميزة اختيار أكثرمن ملف ليتم الرفع دفعة واحدة . ♻ تم تعديل بعض الأجزاء البرمجية ( تحسين أداء ) نسخة 32 | نسخة 64 ــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ Uploader 32.zip | Uploader 64.zip ــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ

تفضل أستاذ @Abdelaziz Osman محاولتي . Abdelaziz Osman.rar

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

جزاك الله عنا كل الخير مشكور وماجور من عند الله، بالفعل اجابتك هي الحل لمشكلتي حاولت مراراً باستعمال الدالة حتى نجح الأمر اعذني فمازلت ببداية مشوار التعلم كل الامتان و التقدير لشخصكم الكريم و رحابة صدرك اخي الكريم شكراً من القلب

هي كانت احتياط ، ولعدم رؤيتي المرفق ، والحمد لله ان مشكلتك قد انتهت 🤗 .

لم ينجح فلم تظهر نتائج تمام الان فقط قمت بازالة is null شكرا جزيلا اخي

حسب ما فهمت من معطياتك ، جرب هذا الاستعلام :- update tbs inner join tbm on tbs.ids = tbm.ids set tbs.idm = tbm.idm where tbs.idm is null;

ولا يهمك ، سألقي نظرة على الملف ونرى نقطة الضعف ، ولكني الآن قد ابتعدت عن الكمبيوتر 😇 . بأقرب فرصة إن شاء الله

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

سلمك الله من كل سوء الاصدار لدي اوفيس 2003 جارى التجريب حالا

لإجراءاتكم بالإفادة إن كانت المشكلة المتعلقة باللغة العربية قد تم حلها أم لا .

حياك الله أخوي @magdidir .. أقل ما يمكننا فعله هو المساعدة .

شكرا جزيلا أخي الفاضل وزادك الله من علمه

الاخ الرائع @Foksh تسلم ايدك يا النشمي وبارك الله فيك وجزاك الله كل خير ، انا ممنونلك يا اخوي

بعد فهم الموضوع بشكل مناسب ، جرب تعديل المديول X1 بهذا التعديل البسيط Option Compare Database Option Explicit Sub AddToWheredate(fieldvalue As Variant, FieldName As String, MyCriteria As String, ArgCount As Integer) Dim mydate As Variant If fieldvalue <> "" And IsDate(fieldvalue) Then mydate = fieldvalue mydate = Format(mydate, "m-d-yy") If ArgCount > 0 Then MyCriteria = MyCriteria & " and " End If MyCriteria = (MyCriteria & FieldName & " = #" & mydate & "#") ArgCount = ArgCount + 1 End If End Sub Sub AddToWhereegal(fieldvalue As Variant, FieldName As String, MyCriteria As String, ArgCount As Integer) If fieldvalue <> "" Then If ArgCount > 0 Then MyCriteria = MyCriteria & " and " End If If IsNumeric(fieldvalue) Then MyCriteria = (MyCriteria & FieldName & " = " & fieldvalue) Else MyCriteria = (MyCriteria & FieldName & " = " & Chr(39) & fieldvalue & Chr(39)) End If ArgCount = ArgCount + 1 End If End Sub Sub AddToWherelike(fieldvalue As Variant, FieldName As String, MyCriteria As String, ArgCount As Integer) If fieldvalue <> "" Then If ArgCount > 0 Then MyCriteria = MyCriteria & " and " End If If IsNumeric(fieldvalue) Then MyCriteria = (MyCriteria & FieldName & " = " & fieldvalue) Else MyCriteria = (MyCriteria & FieldName & " like " & Chr(39) & fieldvalue & Chr(42) & Chr(39)) End If ArgCount = ArgCount + 1 End If End Sub Sub addtowherecenter(fieldvalue As Variant, FieldName As String, MyCriteria As String, ArgCount As Integer) If fieldvalue <> "" Then If ArgCount > 0 Then MyCriteria = MyCriteria & " and " End If If IsNumeric(fieldvalue) Then MyCriteria = (MyCriteria & FieldName & " = " & fieldvalue) Else MyCriteria = (MyCriteria & FieldName & " like " & Chr(39) & Chr(42) & fieldvalue & Chr(42) & Chr(39)) End If ArgCount = ArgCount + 1 End If End Sub Sub AddToWherenombre(fieldvalue As Variant, FieldName As String, MyCriteria As String, ArgCount As Integer) If fieldvalue <> 0 Then If ArgCount > 0 Then MyCriteria = MyCriteria & " and " End If If IsNumeric(fieldvalue) Then MyCriteria = (MyCriteria & FieldName & " = " & fieldvalue) Else MyCriteria = (MyCriteria & FieldName & " = " & Chr(39) & fieldvalue & Chr(39)) End If ArgCount = ArgCount + 1 End If End Sub

شكرا جزيلا 🙂

وعليكم السلام ورحمة الله وبركاته ,, جرب هذا التعديل أخي الكريم . أما فيما يخص زر السكانر ، فقد تم تعديل بسيط ولم يتم تجربته لعدم توافر سكانر لدي CARD.zip

اخي @Fokshعمل رائع . هذا هو المطلوب بالضبط جزاك الله كل الخير. وبارك الله فيك وزادك في العلم ألف شكر وامتنان

هلا وغلا استاذنا الكبر @jjafferr هي مشكلة بسيطة ربط جدول مع استعلامين كان اخونا الحبيب @kkhalifa1960 رابط الجدول مع الاستعلامات بواسطة ID وفي هذه الحالة لا يجلب البيانات الا اذا تم تعبئة الثلاث جداول وهذا الامر يتعارض مع البرنامج بحيث يمكن يتم تسجيل البيانات ويدفع الدفع لاحقا قمت بالالغاء العلاقات وعملت علاقات بشرط ان يجلب كافة البيانات من الجدول الرئيسي وزبطت والحمد لله

الاصل في مثل هذا الحدث ان يتم على نموذج مفرد والتعامل مع سجل واحد ، من اجل تمرير قيمة او عملية محددة . وغالبا هذا ما يسعى اليه صاحب الموضوع . اعتراضي او قل : وجهة نظري .. انه من غير المنطق ان اقوم بتحديث 10 آلاف سجل أو اكثر عند كل عملية اجريها على سجل واحد والتي قد تتكرر في الدقيقة مرات عديدة . قد اخترع مصطلح لتسمية مثل هذه الاجراءات واسميه بــــــــ الاعتداء البرمجي

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

مشاركة مع اساتذتي تفضل استاذي @عبد اللطيف سلوم المرفق بعد التعديلان . نهائي 3-1.rar

والله مافهمت المطلوب على العموم انت عندك مشكله في داله الجمع اعطيك مثال وانت طبق عليها بمعرفتك للجداول والارقام ووو =Nz(DSum("[X_ALL]";"[TBL_RESERVATIONS]";"[ID]=" & [ID] & "");0) هذة داله الجمع الشرط هنا انه الاي دي يساوي الايادي بمعني تقله احمع بشرط رقم العميل يساوي الرقم

تسلم يا غالي هذا هو المطلوب عاشت ايدك

تفضل استاذنا @عبد اللطيف سلوم المرفق بعد العمل على طلبك . B2B HOT 2025-1.rar

هلاهلا - وهل يفتي ومالك في المدينة؟ ع العموم شكرا على تواضعك هذا - اما بخصوص الانترنت نعم يجب ان تكون متصل بالانترنت؟ اما ملف الجنسيات موجود عندي كامل به كل الجنسيات اذا تبيه برسله لك نعود للكود Private Sub Drive_Nat_AfterUpdate() On Error Resume Next ' استدعاء الدالة Translate لترجمة الجنسية العربي إلى الإنجليزي Dim translatedText As String translatedText = Translate(Me.Drive_Nat.Value, "ar", "en") ' هذه هو مربع التحرير الخاص بك Drive_Nat ' تحديث حقل الجنسيات الإنجليزية NASH If Not IsNull(translatedText) And translatedText <> "" Then ' NASH وهذا مربع التحرير الخاص بالجنسية العربية اذا كان لديك Me.NASH.Value = translatedText Else MsgBox "تعذر الترجمة. يرجى المحاولة مرة أخرى.", vbExclamation, "خطأ في الترجمة" End If ' وهذا حقل الجنسية العربيه بحيث ييم الترجمة فيه ' تحديث الحقل NAOINALTYEN بناءً على الترجمة If Not IsNull(Me.NASH.Value) And Me.NASH.Value <> "" Then Me.NAOINALTYEN.Value = Me.NASH.Value End If ' استدعاء الكود الخاص بتحديث الصور Call NASH_AfterUpdate End Sub قبل ذلك تضع هذا الكود في وحدة نمطية واحفظها Option Compare Database 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?sl=" & strFromSourceLanguage & "&tl=" & strToTargetLanguage & "&q=" & EncodeQP2(strInput) & "&hl=ar" Set objHTML = Nothing Set objHTTP = CreateObject("Msxml2.XMLHTTP.6.0") 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 = "result-container" Then strTranslated = objDiv.innerText Translate = strTranslated End If Next objDiv End Function Function EncodeQP2(s As String) As String Dim i As Long Dim p1 As Long Dim p2 As Long Dim R As String Dim n As Long For i = 1 To Len(s) n = AscW(MID(s, i, 1)) If n < 128 Then R = R & "%" & Hex(n) ElseIf n < 2048 Then p1 = n \ 64 R = R & "%" & Hex(p1 + 192) p2 = n Mod 64 R = R & "%" & Hex(p2 + 128) Else End If Next i EncodeQP2 = R End Function

بارك الله فيك اخي @Foksh بعد ان رفعت الموضوع تيقنت اني لم اعبر بالطريقة الصحيحة عن مرادي: الية البحث تتم على حقل النصي وليس حقل رقم الشركة او رقم السائق، فالدالة تقرأ من خانة النص ، والمطلوب هو ان يتم البحث على الحقل الرقم وسأرفق صورا توضح المطلوب بإذن الله:

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

حسناً ، دعنا نتحايل على طريقة عرض القيم كالتالي :- الملف بعد التعديل :- BASEK.accdb

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

بارك الله فيك هذا هو المطلوب

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

بارك الله فيك كود ممتاز

شكرا ليك استاد

في هذا التحديث تم إضافة ميزات جديدة وتحكم أكثر مرونة وسلاسة ؛ بحيث :- تم إضافة فكرة إضافة مجلد على جوجل درايف بشكل مباشر . وعلى عكس الفكرة الأولى ، فقد تم إضافة ميزة حذف مجلد من جوجل درايف بشكل مباشر أيضاً . للأشخاص الذين يرغبون في إعادة تصفير إعدادات الأداة وحذف القيم كاملة ةاستخدام الأداة كإنها جديدة ، تم إضافة ميزة مخفية تقوم بتصفير اعدادات الأداة عند النقر المستمر مدة 6 ثواني على زر النسخ ، ثم ستظهر رسالة تخبرك بأنه تم إعادة ضبط الإعدادات وسيتم إعادة تشغيل الأداة من جديد . 🔴 وجب التنبيه أن هذه الخطوة ستقوم بحذف رمزي ( CLIENT ID و CLIENT SECRET ) اللذين من المفترض أنك حصلت عليهما باتباعك الخطوات السابقة عند إنشائك المشروع . ولإعادة الحصول عليهما ، فقط توجه للرابط ، ثم اختر اسم مشروعك ، ثم تفعيل خدمات API ثم انتقل الى التبويب credentials واختر اسم مشروعك وستجدهما في الصفحة كما في الصورة الأخيرة في رأس الموضوع . النسخة الجديدة متاحة للتحميل للنسختين 32 و 64 . نسخة 32 | نسخة 64 ــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ Uploader 32.zip | Uploader 64.zip ــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ صورة للواجهة الجديدة مع الإضافات .