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

سيكون الكود بهذا الشكل #If VBA7 Then Private Declare Function TWAIN_AcquireToFilename Lib "TWAIN32d.DLL" (ByVal hwndApp As Long, ByVal bmpFileName As String) As Integer Private Declare Function TWAIN_IsAvailable Lib "TWAIN32d.DLL" () As LongPtr Private Declare Function TWAIN_SelectImageSource Lib "TWAIN32d.DLL" (ByVal hwndApp As Long) As LongPtr #ElseIf Win64 Then Private Declare Function TWAIN_IsAvailable Lib "TWAIN32d.DLL" () As LongPtr Private Declare Function TWAIN_SelectImageSource Lib "TWAIN32d.DLL" (ByVal hwndApp As Long) As LongPtr #Else '32-bit Office Private Declare Function TWAIN_IsAvailable Lib "TWAIN32d.DLL" () As Long Private Declare Function TWAIN_SelectImageSource Lib "TWAIN32d.DLL" (ByVal hwndApp As Long) As Long #End If

واليك هذا الرابط لعله تستفيد منه في المستقبل مثال يعمل على اكسس 32 بت و 64-بت

غير موجود الا بمقابل كما رأيت او عليك بتصميم ملف واذا تعثرت فى حاجة يمكنك رفعه هنا وان شاء الله سوف تلقى المساعدة بارك الله فيك

العفو اخي الكريم بارك الله فيك

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

عند فتح البرنامج بالشفت اختار ملف وفي تحت حفظ & نشر وبعدها اختار mde

يوضع في اعلى النموذج

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

نحن هنا لكي الكل يستفيد و يعلم اشياء جديدة اتفضل اليك هذا الرابط به شرح بسيط و راح تعرف كيف ستنقذ ان شاء الله الأكسس-32-بت،-64-بت

حتى الان ماشي الحال لكن المثال محير شوف هل يعني ان اليوزر اي رقم 4 دخل الى الشركة في يوم 30-9-2018 ولن خرج منه و بعدين في يوم 2-10-2018 دخل الى الشركة من جديد اذا كيف دخل من جديد في يوم 2-10-2018 ولن خرج منه من قبل اي في 30-9-2018 وبعده ؟

جرب ادرج الكلمة PtrSafe بين الكلمتين Declare PtrSafe Function كما في المثال

مساء الخير برنامج الصادر والوارد محاولة جديدة... مستنى رأيكم الصادر والوارد.xlsm

كما اشار استاذ @Khalf اذا كان هناك اختلاف الاصدار بين الجهازين اتفضل اليك هذا الرابط راح تستفيد منه للمستقبل https://www.officena.net/ib/topic/64325-مثال-يعمل-على-اكسس-32-بت-و-64-بت/

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

لا أحسب أن المشكلة هي في نوع المعالج و لكن في كون الجهاز ٦٤ بت أو ٣٢ بت . و بما أني لم أشاهد المرفقات بعد ، يمكن لي أن أقول أن البرنامج بصيغة accde أو mde و بهذه الحالة لا يمكن للبرنامج أن يعمل على جهاز من فئة بت مختلفة عن فئة البت التي تم تحويله إلى إحدى هاتين الصيغتين عليها .

اخي حسين انت حاولت تشوف هذه الخاصية داخل الجهاز او الكتالوج ؟؟ بمعني انك بحثت داخل الجهاز من خلال الخصائص او الضبط ؟؟؟ اعتقد غالبا ستكون داخل خصائص عرض الشاشة حيث ان هذه الشاشات تباع منفصلة عن طريق منفذ الusb

لايوجد في (الاكواد البرمجية) مرة تم ومرة ما نفع تم : يعني الكود صحيح وشغال ما نفع : ليس لها محل هات مثالك الذي تعمل عليه حتى أبين لك مكان الخلل

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

أمامنا جدول مع بيانات مختلفة 1- انقر على اي خلية من الجدول (ما عدا رأس الجدول) لتحصل على فلتر بقيمة هذه الخلية 2-انقر على اي خلية ( من رأس الجدول) لتحصل على كل البيانات 3-لإضافة بيانات على الجدول انقر على اول صف فارغ وأملأ الصف كما تشاء (لا يعمل الماكرو الا اذا كان الصف كاملاً ببياناته 4 قيم) ملاحظة: لا يعمل الماكرو Reset ولا الماكرو Make_On_Top كل بمفرده الا من خلال الماكرو الرئيسي SelectionChange الماكرو Option Explicit Dim Lr%, Rng As Range '========================== Sub Make_On_Top() On Error GoTo Exit_Sub Rng.Rows(1).Interior.ColorIndex = 6 With ActiveSheet .Range("z1") = Cells(3, ActiveCell.Column) .Range("z2") = ActiveCell.Value .Range("a3").CurrentRegion.AdvancedFilter 1, Range("z1:z2") .Cells(3, ActiveCell.Column).Interior.ColorIndex = 8 End With Exit_Sub: End Sub '================================== Sub Reset() On Error GoTo Exit_Sub Rng.Rows(1).Interior.ColorIndex = 6 On Error Resume Next ActiveSheet.ShowAllData On Error GoTo 0 Exit_Sub: End Sub '=========================== Private Sub Worksheet_SelectionChange(ByVal Target As Range) Lr = Cells(Rows.Count, 1).End(3).Row Set Rng = Range("A3:D" & Lr) If Not Intersect(Target, Rng) Is Nothing And _ Application.CountA(Range(Cells(Target.Row, 1), _ Cells(Target.Row, 4))) = 4 _ And Target.Cells.Count = 1 Then If Target.Row = 3 Then Reset Else Make_On_Top End If End If Range("z1:z2").Clear End Sub الملف مرفق Super Adv_Filter.xlsm

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

قبل الان انا رديت عليك هكذا والان عملت لك هذا test 15 (1).rar

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

السلام عليكم و رحمة الله و بركاته لاشك ان عمل استاذ شفان يستحق المدح وحبيت اضافة بسيطه الا وهو تحديد و تصدير اكثر من حقل في وقت واحد المثال: test 15.zip

اذا الحقول محددة كل مرة اعمل استعلام بالحقول المطلوبة واحفظه باسم QForExport واستخدم هذا السطر من الكود فقط DoCmd.OutputTo acOutputQuery, "QForExport", acViewPreview

ليس من المهم اي قاعدة تشتغل عندك المهم توصل للحل كما حضرتك تريد عندي بيشتغل كلا القاعين وبدون اي مشاكل اتفضل تم استخدام هذه الاكواد Private Sub ChooseField_AfterUpdate() If Not IsNull(Me.ChooseField) = True Then If Len(Me.TxtForQuery & vbNullString) > 6 Then Me.TxtForQuery = Me.TxtForQuery & " " & "," & Me.ChooseTble & "." Me.TxtForQuery = Me.TxtForQuery & Me.ChooseField Else Me.TxtForQuery = Me.TxtForQuery & " " & Me.ChooseTble & "." & Me.ChooseField End If Me.EndForQuery.Enabled = True End If Me.ChooseField.RemoveItem (Me.ChooseField) End Sub Private Sub ChooseTble_AfterUpdate() Set db = CurrentDb Set Td = db.TableDefs(Me.ChooseTble) Me.ChooseField.RowSource = "" Me.ChooseField.AddItem ("اسماء الحقول") For Each fld In Td.Fields If fld.Type = 4 And fld.Attributes = 17 Then Me.ChooseField.AddItem (fld.Name) Else Me.ChooseField.AddItem (fld.Name) End If Next End Sub Private Sub EndForQuery_Click() On Error Resume Next Dim CountStrTbl As Integer CountStrTbl = Len(Me.ChooseTble) Me.ExportTo.Enabled = True If Left(Me.TxtForQuery, CountStrTbl) = Me.ChooseTble Then Exit Sub Me.TxtForQuery = Me.TxtForQuery & " From " & Me.ChooseTble Me.EndForQuery.Enabled = False End Sub Private Sub ExportTo_Click() On Error Resume Next DoCmd.DeleteObject acQuery, "QForExport" Set QFEx = CurrentDb.CreateQueryDef("QForExport", Me.TxtForQuery) DoCmd.OutputTo acOutputQuery, "QForExport", acViewPreview DoCmd.DeleteObject acQuery, "QForExport" MsgBox "تم تصدير بالنجاح" End Sub test 15 - Copy.rar

بارك الله فيك وانت الاروع اخي

في هذه الحاله لايقبل التكرار لانه سوف يكون قد حذف من الجدول السابق اليك الكود بما طلبت حذف ونقل DoCmd.SetWarnings False DoCmd.RunSQL "INSERT INTO Team ( ID, Fullname, tel, Degree, class ) " & vbCrLf & _ "SELECT Students.ID, Students.Fullname, Students.tel, Students.Degree, Students.class " & vbCrLf & _ "FROM Students " & vbCrLf & _ "WHERE (((Students.ID)=[Forms]![Form]![Text0]));" DoCmd.RunSQL "DELETE Students.ID, Students.Fullname, Students.tel, Students.Degree, Students.class " & vbCrLf & _ "FROM Students " & vbCrLf & _ "WHERE (((Students.ID)=[Forms]![Form]![Text0]));" DoCmd.SetWarnings True Me.Text0 = ""

الحمد لله أستاذى الفاضل أننا توصلنا الى ذلك حقيقةً سيدى الفاضل لم أتمكن بنفسى من التعديل وانما بمساعدة Mr. Jan Karel Pieterse أحد مطورى شركة مايكروسوفت .الرجل أعطانى رابط فى موقعه الخاص : http://www.jkp-ads.com/articles/apideclarations.asp وبصراحة أنا خدتها من قصيرها وطلبت منه التعديل عشان أضمن ازاى بيحوّل التصريحات لكى تعمل فى ويندوز 32 و 64 ولم يتأخر الرجل مشكورا . وبإذن الله سأحاول فى الفترة القادمة إزاى تم تحويل تصريحات تعمل فى 32 الى تصريحات تعمل فى 32 و64 طبقا للرابط المذكور. ويبدو أن كلمة السر عند مايكروسوفت فى التعديل الذى أصدرته لـ Win32API.txt هذا التعديل هو Office2010Win32API_PtrSafe حسب ما فهمته من الرابط المذكور ملحوظة : مرفق حضرتك بعمل على win_ 32 bit and win_64 bit تحياتى لك Win32API_PtrSafe.rar

الأستاذ / أبو صلاح السلام عليكم ورحمة الله وبركاته إليك الملف لعله المطلوب. ترتيب الاسماء تلقائي1.rar

السلام عليكم *********** اخى ابوعبدالله حياك الله فى المرفقات ا) الملف الاول اظهار ماهى الشيتات المخفية دون اظهارها ) الملف التانى اظهار الاوراق المخفية طاب يومكم 1.rar كود اظهار الاوراق المخفية.rar

أخي العزيز رجاء الاطلاع على المرفق وفيه عند أي تغيير في عمود أفضل خطف يتم إعادة ترتيب مراكز ونقاط اللاعبين تلقائياًحسب طلبك . تحياتي أبو عبدالله ترتيب تلقائي.rar