kkhalifa1960 قام بنشر يناير 4, 2021 قام بنشر يناير 4, 2021 عليهم أنا حاولت بالصفحة الأولى ولكن لم أفلح (tabl1 , IPic Attachment) لدى تاب كنترول به 6 صفحات وكل صفحة موزع عليها 27 زر أمر وأريد ضبط الكود لتوزيع الصور التي بالجدول Restaurant.rar
SEMO.Pa3x قام بنشر يناير 4, 2021 قام بنشر يناير 4, 2021 عزيزي، اشرح بتفصيل أكثر مالذي تريده صراحة لم افهم شيء من طلبك.
kkhalifa1960 قام بنشر يناير 4, 2021 الكاتب قام بنشر يناير 4, 2021 حياك الله يادكتور أنا وزعت أسماء أزرار الأمر بالصفحة الأولى وباقي توزيع الصور المدمجة بالجدول كي تظهر على الأزرار بنفس الصفحة أنا حاولت ولكن الصور كلها تشتغل بالصورة البديلة فهل ممكن ضبط كود عند تحميل النموذج
jjafferr قام بنشر يناير 5, 2021 قام بنشر يناير 5, 2021 السلام عليكم 🙂 انا عملت تغيير في النموذج ، واصبح بسيط : . بس هذه طريقة المجلدات . كود النموذج الرئيسي: Option Compare Database Option Explicit Private Sub cmd_quit_Click() DoCmd.Close acForm, Me.Name End Sub Private Sub Form_Load() Dim rst As DAO.Recordset Dim Pics_Path As String Dim RC As Long, i As Long 'the main buttons Set rst = CurrentDb.OpenRecordset("Select [FN],[Resturant] From Query_S_S Where S_S is not null Order By S_S") rst.MoveLast: rst.MoveFirst: RC = rst.RecordCount For i = 1 To 6 'path to the pitures folder Pics_Path = Mid(Application.CurrentProject.Path, 1, InStrRev(Application.CurrentProject.Path, "\") - 1) Me("cmd" & i).Caption = rst!Resturant Me("cmd" & i).Picture = Pics_Path & "\my foto333\" & rst!FN rst.MoveNext Next i rst.Close: Set rst = Nothing 'show if 1st button clicked Me.WhichCMD = 1 Call sfrm_Controls End Sub Function cmd_Click() Me.WhichCMD = Right(Screen.ActiveControl.Name, 1) Call sfrm_Controls End Function Function sfrm_Controls() On Error GoTo err_sfrm_Controls Dim rst As DAO.Recordset Dim Pics_Path As String Dim RC As Long, i As Long, iStart As Long Dim ctl As Control 'the main buttons Set rst = CurrentDb.OpenRecordset("Select [FN],[ID], [iName] From qry_Table1 Where S_S=" & Me.WhichCMD & " Order By ID") rst.MoveLast: rst.MoveFirst: RC = rst.RecordCount For i = 1 To RC 'path to the pitures folder, then path with file name Pics_Path = Mid(Application.CurrentProject.Path, 1, InStrRev(Application.CurrentProject.Path, "\") - 1) Pics_Path = Pics_Path & "\my foto333\" & rst!FN Me("sfrm_items")("c" & i).BackColor = Me("cmd" & WhichCMD).BackColor 'Back Color Me("sfrm_items")("c" & i).ForeColor = Me("cmd" & WhichCMD).ForeColor 'Fore Color Me("sfrm_items")("c" & i).Caption = rst!INAME 'Caption 'picture If Dir(Pics_Path) <> "" Then Me("sfrm_items")("c" & i).Picture = Pics_Path Else 'file type was not found, trye jpg Me("sfrm_items")("c" & i).Picture = Mid(Pics_Path, 1, Len(Pics_Path) - 3) & "jpg" End If Me("sfrm_items")("c" & i).Tag = rst!ID 'ID in Tag , so when clicking on the button we know which one Me("sfrm_items")("c" & i).Visible = True 'show the control rst.MoveNext Next i 'hide all subform controls For Each ctl In Me("sfrm_items").Controls Me("sfrm_items")("c" & i).Visible = False i = i + 1 Next Exit_sfrm_Controls: rst.Close: Set rst = Nothing Exit Function err_sfrm_Controls: If Err.Number = 2220 Then 'No picture Me("sfrm_items")("c" & i).Picture = "" Resume Next ElseIf Err.Number = 2465 Then 'we passed the number of controls Resume Exit_sfrm_Controls Else MsgBox Err.Number & vbCrLf & Err.Description End If End Function . ولما تنقر على اي من ازرار النموذج الفرعي ، تحصل على . وكود النموذج الفرعي: Option Compare Database Option Explicit Function myItems() 'get the items detail Dim A As String Dim x() As String Dim Resturant As String, S_S As Double, INAME As String, sal_price As Double, Qty1 As Integer, ID As Long A = DLookup("Resturant & '|' & S_S & '|' & INAME & '|' & sal_price & '|' & Qty1", "TABL1", "[ID]=" & Screen.ActiveControl.Tag) x = Split(A, "|") Resturant = x(0) S_S = x(1) INAME = x(2) sal_price = x(3) Qty1 = x(4) ID = Screen.ActiveControl.Tag MsgBox "Resturant =" & x(0) & vbCrLf & _ "S_S =" & x(1) & vbCrLf & _ "INAME =" & x(2) & vbCrLf & _ "sal_price =" & x(3) & vbCrLf & _ "Qty1 =" & x(4) & vbCrLf & _ "[ID]=" & Screen.ActiveControl.Tag End Function جعفر 1321.1.RestTest111.accdb.zip 2
kkhalifa1960 قام بنشر يناير 5, 2021 الكاتب قام بنشر يناير 5, 2021 كما عودتنا على الابداع دائما مبدع وماشاء الله عليك يا برفيسور جعفر شكرا جزيلا وبارك الله فيك عمل أكثر من رائع👍
jjafferr قام بنشر يناير 5, 2021 قام بنشر يناير 5, 2021 حياك الله 🙂 في تعديل بسيط ، حيث تم اضافة مربع النص NoFocus في النموذج الفرعي ، ويجب ان لا تجعله مخفي ، ويمكنك ان تجعله تحت اول زر امر اذا اردت ، السبب في احتياجه هو ، عندما نختار مادة وتظهر لنا رسالة بياناتها (طبعا انت لن تستعمل الرسالة ، وانما ستستخدم بياناتها 🙂) ، فلا تستطيع ان تختار من القائمة الرئيسية مرة اخرى : . واما في الكود ، فقد تم اضافته في كود النموذج الفرعي ، هكذا: . جعفر 1321.1.RestTest111.accdb.zip 1
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.