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

سهله 🙂 بدل ما نأخذ اسم ملف الجداول ومساره من BE_Path = DLookup("[Database]", "MSysObjects", "[Flags]=2097152") 'Path and BE name انت اكتبه يدويا، هكذا BE_Path = "D:\myDB\my_BE.mdb" 'Path and BE name او BE_Path = application.currentdb.path & "\myDB\my_BE.mdb" 'Path and BE name جعفر

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

اضافة لما تفضل به الاستاذ @أحمد الفلاحجى اذا لم ترغب في الاستعلام ممكن عملها في النموذج في حدث بعد التحديث للحقل time نضع الكود التالي Me.dated = DateAdd("d", -[time], Date)

الاستاذ العزيز @أحمد الفلاحجى فكرة ذكية استخدام اسنعلام التحديث

تفضل لك ما طلبت Payroll.xlsm

وعليكم السلام شوف الاستعلام لعل هذا ما تريد Expr1: DateAdd("d";-[time];Date()) او استخدم استعلام التحديث لتحديث الحقل dated بالنتيجه تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق exp(1).accdb

الشكر لله ثم لاخواننا واساتذتنا جزاهم الله خيرا هل تقصد حذفه من جدولى القيد الاساسى بعد الترحيل ؟ اذا كان كذلك اتفضل ان كان غير ذلك وضح اكثر بارك الله فيك Move Data TableDatabase_up.rar

ممتاز 🙂 اروح آخذ غفوة الظهيرة ، والليلة خير ان شاء الله 🙂 جعفر

في حدث بعد التحديث للحقل TYPE بعد الكود الذي كتبه اخي احمد ضع الكود التالي Me.OTHER = Me.NUMBER + 10 ولكن ماذا لو اردت تغيير القيمة الى 15 او 20 الافضل اضافة مربع نص للقيمة TEST AA1.accdb

الشكر لله ثم لاخواننا واستذتنا جزاهم الله خيرا اخى @عذاب الزمان يفضل بعد ذلك فتح موضوع جديد مراعاه لقوانين الموقع اتفضل ان شاء الله يكون ما تريد تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق TEST AA(2).accdb

فعلا والله ولكن ازهر يستاهل

جرب الان قائمة منسدلة.accdb

😀 والله انا مثلك اخى @kha9009lid هو عنده الحلين يختار بقى اللى يحبه جزاكم الله خيرا

IIf([dateexp]<=[datee];"red";"green") ما اعرف انا فهمت المطلوب لكن قلت باشارك exp - Copy.accdb

يطول عمرك اخي احمد ونحن نكمل بعض

اخى الفاضل @عذاب الزمان اتفضل شروحات من منتدانا العزيز ومن منتدى الفريق العربى للبرمجه جزاهم الله خيرا اخواننا واساتذتنا http://arabteam2000-forum.com/index.php?/topic/250549-استخدام-الدالة-dlookup/ اخى واستاذى العزيز @kha9009lid احسنت بارك الله فيك وجزاك الله خيرا صحيح وشكرا للتنبيه اخى واستاذى @kha9009lid هذا لانى قمت بجعل الحقل غير منضم على ونسيته ارفقته بعد التعديل جزاك الله خيرا TEST AA.accdb

كود مختصر اكثر Me.NUMBER = Me.TYPE.Column(2) TEST AA.accdb استاذنا الفاضل @أحمد الفلاحجى في مرفقك بعد التنفيذ لا يتم الحفظ في جدول TBL1

وعليكم السلام اتفضل ان شاء الله يكون ما طلبت بعد اختيار حقل type سيتم جلب القيمه فحقل numper تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق TEST AA.accdb

للرفع

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

اخي الفاضل الموضوع مكرر أكثر من مرة ..... كان بامكانك كتابة للرفع فقط ,,,,,,, على كل حال انظر التعديل على الملف ..... ربما هو طلبك .... db1 (2).accdb

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

'الكود يتحدث إذا كان حقل الايدي فارغ If IsNull(Me![id]) = True Then ' يتم عرض رسالة تفيد بأن الحقل فارغ MsgBox " عفواً أخي الكريم حقل الآيدي " & " [ " & " !!! " & " ] " & "فارغ", vbCritical, "تنبيه" ' تثبيت المؤشر في الحقل الفارغ نفسه id.SetFocus ' أخرى يتبع إلى الباقي Else If IsNull(Me![اسم المشترك]) = True Then MsgBox " عفواً أخي الكريم حقل اسم المشترك " & " [ " & " !!! " & " ] " & "فارغ", vbCritical, "تنبيه" Me.اسم_المشترك.SetFocus Else If IsNull(Me![رقم الهاتف]) = True Then MsgBox " عفواً أخي الكريم حقل رقم الهاتف " & " [ " & " !!! " & " ] " & "فارغ", vbCritical, "تنبيه" Me.رقم_الهاتف.SetFocus Else If IsNull(Me![البريد الالكتروني]) = True Then MsgBox " عفواً أخي الكريم حقل البريد الألكتروني " & " [ " & " !!! " & " ] " & "فارغ", vbCritical, "تنبيه" Me.البريد_الالكتروني.SetFocus Else DoCmd.GoToRecord , , acNewRec End If: End If: End If: End If: بحثت لك فوجدت هذا الكود ربما يلبي لك بعض ما تريد ..

شكراً لسيادتكم على المساعدة القيمة و كذا على رد سيادتكم المهذب

تم العديل على الماكرو ليتناسب مع ما تريد الاعمدة حيث كلمات معلومة1 /معلومة 2 الخ... (يجب اخفائها من أجل ملاحظة البيانات جيداً) يمكنك اظهارها اذا كانت ضرورية حجم الملف كبير جداً (حوالي 16 ميغا مضغوطاً) لذلك لم استطع رفعه فقط ادرج هذا الكود في ملف تجريبي (نسخة ثانية من نفس الملف) عندك وقم بتجربته (اشدد على النسخة الاحتياطية ربما كان هناك اخطاء و كما تعرف لا يمكن التراجع (Undo) بعد تنفيذ الماكرو) Option Explicit Sub Salim_Code() Rem Created By Salim Hasbaya On 21/3/2020 Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim All As Worksheet Dim Source_sh As Worksheet Set All = Sheets("All_In Order"): Set Source_sh = Sheets("data1") Dim RgD As Range, c As Range Dim st$, t$, Mon_array() Dim m%, lr%, lrc%, Er%, lc%, lastRo_data1% lastRo_data1 = Source_sh.Cells(Rows.Count, "D").End(3).Row If lastRo_data1 <= 3 Then Exit Sub Set RgD = Source_sh.Range("D4:D" & lastRo_data1) Mon_array = Array("ا", "ب", "ت", "ث", "ج", "ح", "خ", "د", "ذ", _ "ر", "ز", "س", "ش", "ص", "ض", "ط", "ظ", "ع", "غ", "ف", _ "ق", "ك", "ل", "م", "ن", "ه", "و", "ي") With All .Range("B5").Resize(9999, 11 * 28).ClearContents For Each c In RgD t = Mid(Trim(c), 1, 1) st = Left(t, 1) If st = "أ" Or st = "آ" Or st = "إ" Then st = "ا" m = Application.Match(t, Mon_array, 0) If Not IsError(m) Then lc = (m - 1) * 11 + 3 lr = Application.Max(5, .Cells(Rows.Count, lc).End(xlUp).Row + 1) .Cells(lr, lc - 1).Value = lr - 4 .Cells(lr, lc).Resize(1, 7).Value = _ c.Offset(, -2).Resize(1, 7).Value .Cells(lr, lc + 7).Value = Source_sh.Cells(c.Row, "o") .Cells(lr, lc + 8).Value = Source_sh.Cells(c.Row, "AJ") Else: Er = Er + 1: End If Next .Columns.AutoFit .Range("a1").ColumnWidth = 22 End With MsgBox "تم بحمد الله" & IIf(Er > 0, vbCr & Application.Rept("=", 30) & vbCr & "عدد الاسماء الخطا غير المرحلة" & vbCr & Er, "") Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub

سؤال أخير: كم سجل عندك في الجدول Imagetable ؟

وعليكم السلام اتفضل ان شاء الله يكون ما تريد اضغط ع زر الترحيل تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق Move Data TableDatabase_up.rar

اخي محمد ، رجاء انزل المرفق الجديد ، شغل البرنامج ، وشغل التقرير ، اريدك لوسمحت تعمل صورة من الشاشة ، واطبع التقرير ، واريد صورة من الورقة المطبوعة 🙂 هذه آخر افكار على بالي ، فرجاء تنفيذها 🙂 جعفر 1186.1.accdb

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

جرب الان قائمة .accdb

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

اشكركم اخواني جميعا جميعكم في قمة الابداع والرقي علما وخلقا حفظكم الله من كل سوء بحاجة لاضافة اخرى .... وشرحها في المرفق نفسه لو سمحتم ... مثلا اريد الناتج الذي يظهر في مربع نص NUMBER اجمعه مع اي رقم وليكن 10 ليظهر في مربع نص اخر تلقائيا ...اي كلما تتغيير محتويات مربع نص NUMBER يقوم بالجمع ويظهر التغيير بمربع النص الاخر ...يعني الكود باي حدث يوضع بمجر تغيير قيمة مربع نص NUMBER. ولكم مني جزيل الشكر TEST AA.accdb

وعليكم السلام اتفضل اخى @ازهر عبد العزيز ان شاء الله يكون طلبك تقيل تحياتى وتمنياتى لك وللجميع بالتوفيق exp - Copy.accdb

مشاركتي رقم2 فيها المطلوب عن طريق قائمة منسدلة ويتم الحفظ في الجدول

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

في الملف الذي رفعنه لك اكتب في الخلية G1 ي 250 و في الخلية G2 ي 350 وترى النتيجة

في هذه الجزئية من الكود فقط اجعل الحلقة التكرارية تبدأ من الرقم 4 ( وهو رقم الصفحة الني يبدأ الكود عمله منها)

السلام عليكم مشاركة مع الاستاذ @kha9009lid دالة بنفس الحفل تحياتي قائمة منسدلة.rar

طريقة اخرى عن طريق مربع تحرير وسرد قائمة منسدلة2.accdb

ممكن بدون الحاجة الى قائمة منسدلة فقط ضع مربع نص غير منظم قيمتة تساوي Choose([f_sex];"ذكر";"انثى")) واذا ترغب في اخفاء عبارة خطا عند السجل الجديد ضع =IIf(IsNull([f_sex]);"";Choose([f_sex];"ذكر";"انثى")) ملفك في المرفقات قائمة منسدلة.accdb

تم التعديل كما تريد Option Explicit Sub Create_Sheet_WITH_HYPER() Rem =======>> CREATED BY SALIM HASBAYA ON 20/3/2020 Dim Tg As Worksheet Dim i%, My_name$ Dim RGA As Range, Var_Rg As Range Dim Final_Rg As Range, Ro% Application.ScreenUpdating = False Set RGA = Salim.Range("C8").CurrentRegion.Columns(1) If Salim.AutoFilterMode Then Salim.Range("c8").CurrentRegion.AutoFilter End If Application.DisplayAlerts = False For Each Tg In Sheets If Tg.Name <> "Salim" Then Tg.Delete Next Tg Application.DisplayAlerts = True For i = 4 To 6 'تستطيع ان تغير الرقم 7 الى اي رقم اقل من 72 (عدد الأعمدة+4) Set Var_Rg = Salim.Cells(8, i).CurrentRegion.Columns(i - 2) Var_Rg.AutoFilter 1, Criteria1:="<>" If Len(Salim.Cells(8, i)) > 30 Then My_name = Left(Salim.Cells(8, i), 30) Else My_name = Salim.Cells(8, i) End If Sheets.Add(after:=Sheets(Sheets.Count)).Name = My_name With ActiveSheet RGA.SpecialCells(12).Copy .Range("B2") Var_Rg.SpecialCells(12).Copy .Range("C2") .Range("B:C").Columns.AutoFit .Hyperlinks.Add Anchor:=.Range("E2"), Address:="", SubAddress:= _ "Salim!A9", TextToDisplay:="Goto SALIM" End With Set Final_Rg = ActiveSheet.Range("B2").CurrentRegion Ro = Final_Rg.Rows.Count If Ro > 1 Then With ActiveSheet .Range("A2") = "N#" .Range("A" & Ro + 2).Offset(, 1) = "Sum" .Range("A3").Resize(Ro - 1) = Evaluate("Row(1:" & Ro & ")") .Range("A" & Ro + 2).Offset(, 2).Formula = "=SUM(C3:C" & Ro + 1 & ")" .Range("A" & Ro + 2).Offset(, 2).Value = _ .Range("A" & Ro + 2).Offset(, 2).Value .Range("B2:b3").Copy .Range("A2").Resize(Ro).PasteSpecial Paste:=xlPasteFormats .Range("A" & Ro + 2).Resize(, 3).PasteSpecial Paste:=xlPasteFormats End With Application.CutCopyMode = False End If Salim.Range("C8").CurrentRegion.AutoFilter '============================ Next Salim.Select Application.ScreenUpdating = True End Sub الملف مرفق من جديد My_NEW_filter.xlsm

خلاص مشكور اساتذتي الكرام وجدته في احد برامج الاستاذ جعفر هنا https://www.officena.net/ib/topic/101762-تحديث-المعلومات-في-النموذج/

See This file calculation.xlsx

حيث ان الداتا عندك لا تشكل جدولاً للاكسل (هناك خلايا مدمجة ويجب ان يكون بجانب الجدول عامود فارغ وفوقه صف فارغ) تم ادراج صف فارغ (رقم 7) وعامود فارغ B ليفصل الجدول عن بقية الخلايا ) تم انشاء ملف جديد بما تريد (للانتقال الى اي ورقة فقط اضغط DoubleClick على اسمها من الورقة Salim ) الكود Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim My_name$ On Error Resume Next If Not Intersect(Target, Range("d8:Pb8")) Is Nothing _ And Target.Count = 1 Then My_name = Left(Target, 30) Sheets(My_name & "").Select End If End Sub '++++++++++++++++++++++++++++++++++++++++++++++++++++++ Option Explicit Sub Create_Sheet() Dim Tg As Worksheet Dim i%, My_name$ Dim RGA As Range, Var_Rg As Range Set RGA = Salim.Range("C8").CurrentRegion.Columns(1) If Salim.AutoFilterMode Then Salim.Range("c8").CurrentRegion.AutoFilter End If Application.DisplayAlerts = False For Each Tg In Sheets If Tg.Name <> "Salim" Then Tg.Delete Next Tg Application.DisplayAlerts = True For i = 4 To 7 'تستطيع ان تغير الرقم 7 الى اي رقم اقل من 72 (عدد الأعمدة+4) Set Var_Rg = Salim.Cells(8, i).CurrentRegion.Columns(i - 2) Var_Rg.AutoFilter 1, Criteria1:="<>" If Len(Salim.Cells(8, i)) > 30 Then My_name = Left(Salim.Cells(8, i), 30) Else My_name = Salim.Cells(8, i) End If Sheets.Add(after:=Sheets(Sheets.Count)).Name = My_name With ActiveSheet RGA.SpecialCells(12).Copy .Range("B2") Var_Rg.SpecialCells(12).Copy .Range("C2") .Range("B:C").Columns.AutoFit .Hyperlinks.Add Anchor:=.Range("E2"), Address:="", SubAddress:= _ "Salim!A9", TextToDisplay:="Goto SALIM" End With Salim.Range("C8").CurrentRegion.AutoFilter '============================ Next Salim.Select End Sub الملف مرفق My_filter.xlsm

تفضل عدد الشهور المستحقة حتى الان.xls

برنامج لاخفاء واظهار الاسطر على اساس محتوى الخلية في الاكسل ويستطيع الترتيب على اساس الاحرف الابجدية برنامج رائع للتحميل يرجى الضغط على رابط التحميل http://www.sobolsoft.com/excelsort/download/setup.exe

السلام عليكم مرفق تطبيق لكود استاذنا / عبد الله باقشير ويعمل بكفاءة تكبير_تصغير.rar

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

السلام عليكم هذا حل آخر باستخدام التصفية المتقدمة وبدون دبل كليك اختار اسم الصف تتغير قائمة الإسم حسب اسم الصف ويمكن تطبيقها على الدبل كليك اذا اردت مع التحية رصد الغيابات.rar