ناقل

قم بادخال رقم المنتج الذي اشتريته

جرب الشيفرة هذه ..... On Error Resume Next Dim strSQL3, strSQL1, strSQL2 As String Dim B As New Access.Application Set B = CreateObject("Access.Application") B.OpenCurrentDatabase "D:\New folder (2)\Database.accdb" strSQL1 = "CREATE TABLE asrt_tbl " _ & "(Code INTEGER , cosmotic CHAR(50), available BIT , " _ & "supplier CHAR(50),Unit CHAR(30), unitprice Double ,Quantity CHAR(30) , " _ & "CONSTRAINT asrt_tblConstraint UNIQUE " _ & "(Code, cosmotic, available, supplier, Unit, unitprice, Quantity ));" strSQL2 = "CREATE TABLE asrt_tbl1 " _ & "(Code INTEGER , cosmotic CHAR(50), available BIT , " _ & "supplier CHAR(50),Unit CHAR(30), unitprice Double ,Quantity CHAR(30) , " _ & "CONSTRAINT asrt_tblConstraint UNIQUE " _ & "(Code, cosmotic, available, supplier, Unit, unitprice, Quantity ));" strSQL3 = "CREATE TABLE asrt_tbl2 " _ & "(Code INTEGER , cosmotic CHAR(50), available BIT , " _ & "supplier CHAR(50),Unit CHAR(30), unitprice Double ,Quantity CHAR(30) , " _ & "CONSTRAINT asrt_tblConstraint UNIQUE " _ & "(Code, cosmotic, available, supplier, Unit, unitprice, Quantity ));" B.DoCmd.RunSQL strSQL1 B.DoCmd.RunSQL strSQL2 B.DoCmd.RunSQL strSQL3 B.CloseCurrentDatabase Set B = Nothing B.Quit MsgBox Space(20) & "تمت العملية بنجاح.." & Space(20), msgstyle, "للمعلومية"

هل تريدة يحذف ام ماذا ؟؟؟ ما هو الاجراء المطلوب ??

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

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

هذه يسهل ما تشاء من شروط .... استخدم هذا Dim myCriteria As String myCriteria = "[نوع المستند] = '" & Me.نوع_المستند & "'" myCriteria = myCriteria & " AND " myCriteria = myCriteria & "[كود الدعوي] =" & Me.كود_الدعوي Me.n = DCount("[كود الحركة]", "harka", myCriteria)

هذا مثال اخي الكريم فيه عده صور واستخدامات عديدة للرسائل وبطرق متعددة .... يمكن ان يثري الموضوع .... ناقل.rar

ممكن ترسلها محولة pdf وتحفظها في حاسوبك

.

تفضل ..... moh.rar وهذا الفلدر به القاعدة المنشأ فيها الجداول .... ضع الفولدر في الدرايف D New folder (2).rar

الان مجرب الكود ويعمل .... انظر الجداول الثلاث تم انشاؤها .... Dim strSQL3, strSQL1, strSQL2 As String Dim B As New Access.Application Set B = CreateObject("Access.Application") B.OpenCurrentDatabase "D:\Database.accdb" strSQL1 = "CREATE TABLE asrt_tbl " _ & "(Code INTEGER , cosmotic CHAR(50), available BIT , " _ & "supplier CHAR(50),Unit CHAR(30), unitprice Double ,Quantity CHAR(30) , " _ & "CONSTRAINT asrt_tblConstraint UNIQUE " _ & "(Code, cosmotic, available, supplier, Unit, unitprice, Quantity ));" strSQL2 = "CREATE TABLE asrt_tbl1 " _ & "(Code INTEGER , cosmotic CHAR(50), available BIT , " _ & "supplier CHAR(50),Unit CHAR(30), unitprice Double ,Quantity CHAR(30) , " _ & "CONSTRAINT asrt_tblConstraint UNIQUE " _ & "(Code, cosmotic, available, supplier, Unit, unitprice, Quantity ));" strSQL3 = "CREATE TABLE asrt_tbl2 " _ & "(Code INTEGER , cosmotic CHAR(50), available BIT , " _ & "supplier CHAR(50),Unit CHAR(30), unitprice Double ,Quantity CHAR(30) , " _ & "CONSTRAINT asrt_tblConstraint UNIQUE " _ & "(Code, cosmotic, available, supplier, Unit, unitprice, Quantity ));" B.DoCmd.RunSQL strSQL1 B.DoCmd.RunSQL strSQL2 B.DoCmd.RunSQL strSQL3 B.CloseCurrentDatabase Set B = Nothing B.Quit

تفضل مع ملاحظة التكرار في استعلام الانشاء ..... Dim strSQL3, strSQL1, strSQL2 As String Dim B As New Access.Application Set B = CreateObject("Access.Application") B.OpenCurrentDatabase "D:\New folder (2)\Database.accdb" strSQL1 = "CREATE TABLE asrt_tbl " _ & "(Code INTEGER , cosmotic CHAR(50), available BIT , " _ & "supplier CHAR(50),Unit CHAR(30), unitprice Double ,Quantity CHAR(30) , " _ & "CONSTRAINT asrt_tblConstraint UNIQUE " _ & "(Code, cosmotic, available, supplier, Unit, unitprice, Quantity ));" strSQL2 = "CREATE TABLE asrt_tbl1 " _ & "(Code INTEGER , cosmotic CHAR(50), available BIT , " _ & "supplier CHAR(50),Unit CHAR(30), unitprice Double ,Quantity CHAR(30) , " _ & "CONSTRAINT asrt_tblConstraint UNIQUE " _ & "(Code, cosmotic, available, supplier, Unit, unitprice, Quantity ));" strSQL3 = "CREATE TABLE asrt_tbl2 " _ & "(Code INTEGER , cosmotic CHAR(50), available BIT , " _ & "supplier CHAR(50),Unit CHAR(30), unitprice Double ,Quantity CHAR(30) , " _ & "CONSTRAINT asrt_tblConstraint UNIQUE " _ & "(Code, cosmotic, available, supplier, Unit, unitprice, Quantity ));" B.DoCmd.RunSQL strSQL1 B.DoCmd.RunSQL strSQL2 B.DoCmd.RunSQL strSQL3

اخي حاولت ان ادمج لك الكودين ولم استطع .... اعذرني ... ولا زالت المحاولات مستمرة ...

استخدم هذا الكود .... DoCmd.TransferDatabase acLink, "Microsoft Access", Me.txtPath, acTable, "MSysObjects", "oo", False If DCount("[Name]", "oo", "[Name] = '" & Me.ObjName & "'") = 1 Then MsgBox "الجدول موجود مسبقا" Else MsgBox "الجدول غير موجود" End If

الف لا باس عليك ... اجر وعافية

طيب ممكن مرفق ...

ممكن تتبع اسلوب تقسيم البرنامج ونضع لقاهدة الجداول رقم سري ...

يبدو لي ان الافس فيه مشكلة ..... هل تم تحديثها باخر تحديث ..... لان 10 فيها مشاكل ....

ما شاء الله تبارك الله .... استاذ خبير ..... واستفدت كثير من الكود .... اشكرك بارك الله فيك ...

ملف الاكسل فيه خلايا مدمجة !!!!!!!

عمل الزران الويندوز 10 - 64 bit الاوفيس 19 - 32 bit مشكور اخي @jjafferr

كلام معلم .... صحي اخي الكريم .... منكم نتعلم

جرب المرفق لعلها بداية حل لك للعنوان ...... Public Sub CenterC(frm As Form) Dim SpcF As Integer Dim clen As Integer Dim oldc As String Dim i As Integer oldc = frm.Caption Do While Left(oldc, 1) = Space(1) DoEvents oldc = Right(oldc, Len(oldc) - 1) Loop Do While Right(oldc, 1) = Space(1) DoEvents oldc = Left(oldc, Len(oldc) - 1) Loop clen = Len(oldc) If InStr(oldc, "!") <> 0 Then If InStr(oldc, " ") <> 0 Then clen = clen * 1.5 Else clen = clen * 1.4 End If Else If InStr(oldc, " ") <> 0 Then clen = clen * 1.4 Else clen = clen * 1.3 End If End If SpcF = frm.Width / 61.2244 SpcF = SpcF - clen If SpcF > 1 Then DoEvents frm.Caption = Space(Int(SpcF / 2)) + oldc Else frm.Caption = oldc End If End Sub ex_01 (1).accdb

ممن جدول به هذه البيانات للتجربة

جرب هذا لعله يفيد DoCmd.Echo False me.Refresh DoCmd.Echo True