kanory

وعليكم السلام ورحمة الله وبركاته .... استخدم مثلا Select Case Me.m1.Column(1)

استخدم هذا لمصدر عتصر التحكم لمربعات النص الثلاث مع تعديل العبارة حاضر الى غائب و متأخر ....... للحضور =DCount("[a1]";"[استعلام1]";"[name1] ='" & [Forms]![الرئيسي]![name1] & "' And [a1] ='حاضر' ") للغياب =DCount("[a1]";"[استعلام1]";"[name1] ='" & [Forms]![الرئيسي]![name1] & "' And [a1] ='غائب' ") للتأخر =DCount("[a1]";"[استعلام1]";"[name1] ='" & [Forms]![الرئيسي]![name1] & "' And [a1] ='متأخر' ")

في مربع النص numboerx في حدث بعد التحديث استخدم هذا الكود ............................ Dim D As Object Dim x As Integer Set D = CurrentDb.OpenRecordset("q1") x = Me.Numberx DoCmd.RunCommand acCmdSaveRecord With D Do While Not (.EOF) .Edit .Numberx = x .Update x = x + 1 .MoveNext Loop End With Set D = Nothing

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

وعليكم السلام ورحمة الله وبركاته .... يعني تقصد توزيع ارقام في الاستعلام يبدأ من الرقم الموجود في مربع النص test2 هل هذا صحيح ؟؟؟؟ اذا كان غير ذلك .. وضح بالتفصيل ...

طيب .... هذه نسخة مبسطة كما ذكرت ويمكن الابداع في طريقة تنفيذها ...... 1- النموذج المراد تعديله ... 2- نسخة لإعادة التجربة . طبعا يمكن اضافة اضافات لبرنامج التحديث اخذ مثلا نسخة احتياطية قبل التنفيذ ..... ايضا يمكن اضافة التعرف على برنامج العميل من حيث النسخة وهل البرنامج محدث او لا الى إخره من الابداعات والمهارات ................................... kan_PRO.rar

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

Sub EXPORT_TO_EXCEL_01() '.. EXPORT TO EXCEL USING DOCMD RUNSQL DoCmd.RunSQL "SELECT [ID],[Fullname],[tel] INTO SHEET_NAME IN'" _ & CurrentProject.Path & "\bb'[Excel 8.0;HDR=yes;] FROM data" End Sub Private Sub Command3_Click() On Error Resume Next 'DoCmd.OutputTo acOutputTable, "Data", acViewPreview DoCmd.SetWarnings False EXPORT_TO_EXCEL_01 MsgBox "تم تصدير الجدول بنجاح إلى نفس مجلد قاعدة البيانات سيتم فتح المجلد الآن... " On Error GoTo 1 Application.FollowHyperlink CurrentProject.Path 1: DoCmd.SetWarnings True End Sub

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

استبدله جميعا بهذا الكود ..... Dim Output_Path As String Output_Path = CurrentProject.Path & "\bb" & "-" & Format(Now(), "dd-mm-yyyy") & ".xlsx" DoCmd.TransferSpreadsheet acExport, , "data", Output_Path Application.FollowHyperlink CurrentProject.Path & "\bb" & "-" & Format(Now(), "dd-mm-yyyy") & ".xlsx"

وعليكم السلام ورحمة الله وبركاته .... اذا عرفنا سبب عدم استخدامك حقل نص لذلك ربما نجد لك حل اخر ..... ؟؟؟؟؟

انظر .....

وعليكم السلام ورحمة الله وبركاته حياك وبياك في منتداك بين اخوتك .. ممكن مرفق صغير للعمل عليه والتجربة

اخي الكريم @أبو ماجد الغامدي عدل افضل اجابة .... لاني لم اجب على سؤالك بارك الله فيك ...

تقصد تغير الفريق بالكامل وتستدعي الاحتياط ... ههههه

اعمل جدول مثل هذا ..... حيث يتم طباعة الخطاب حسب الثلاث سجلات بها ::: 1- جزاءات برقم الصادر ( حيث يمكن جعل رقم الصادر متغير تلقائيا كل عملية طباعة يزيادة رقم للسجل بدون تدخل منك . 2- ماهيات برقم ايضا بنفس فكرة الجزاءات ==========================================. 3- والاخيرة نسخة المكتب وهي بدو رقم .... هذا اذا كان فهمي للموضوع سليما .................................................................................

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

جرب المرفق وانظر ......... عند كتابة البحث انقل المؤثر خارج منطقة البحث .... mm.mdb

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

اجعلها حسب التاريخ والوقت ....

تفضل ................... Mahdi119.rar

وعليكم السلام اهلا بك .... حسب ما فهمت من سؤالك انك تريد ارسال كل محتويات المجلد عند ارسال الرسالة .... صحيح .... اذا كان ذلك هو مطلبك ... جرب هذه الشيفرة ...واعلمنا بالنتيجة بارك الله فيك ...... ملاحظة عدل فترات الانتظار حسب سرعة جهازك ... Dim IE As Object Set IE = CreateObject("InternetExplorer.Application") IE.Navigate "whatsapp://send?phone=" & "mobile no" & "&text=" & "hello" Sleep 3000 Call SendKeys("~", True) Sleep 1000 SendKeys "+{TAB}" Call SendKeys("~", True) Sleep 1000 SendKeys "{UP}" SendKeys "{UP}" SendKeys "{UP}" SendKeys "{UP}" Call SendKeys("~", True) Sleep 2000 SendKeys [CurrentProject].[Path] & "\PDF" Call SendKeys("{Enter}", True) Sleep 2000 SendKeys "+{TAB}" SendKeys "^a" Sleep 2000 Call SendKeys("{Enter}", True) Call SendKeys("{Enter}", True) Sleep 5000 Call SendKeys("{Enter}", True) Set IE = Nothing

الكود يعمل فقط على مربع النص الخاص بالتخصص انظر الصورة في الرد السابق لي ..... عموما تفضل ملفك بعد التعديل عليه ........ Database1601.accdb

طيب ادخل على تفصيل النموذج ..... حدث عند الطباعة وادرج الكود التالي .... Dim ctl As Control, strText As Variant, strName As String Me.ScaleMode = 1 For Each ctl In Me.Detail.Controls If ctl.ControlType = acTextBox And ctl.name = "Text4" Then strName = ctl.name If Nz(ctl.Tag, "") = "" Then ctl.Tag = ctl.FontSize End If ctl.FontSize = ctl.Tag Me.FontSize = ctl.FontSize strText = ctl.Value If Len(strText) > 0 Then Do Until TextWidth(strText) < ctl.Width ctl.FontSize = ctl.FontSize - 1 Me.FontSize = ctl.FontSize Loop Do Until TextHeight(strText) < ctl.Height - (ctl.Height * 0.26) ctl.FontSize = ctl.FontSize - 1 Me.FontSize = ctl.FontSize Loop End If End If Next ctl ثم انظر النتيجة ......................

ملفك بعد التعديل ..... db1 (4) (1).mdb