اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

عليهم أنا حاولت بالصفحة الأولى ولكن لم أفلح (tabl1 , IPic Attachment)  لدى تاب كنترول به 6 صفحات وكل صفحة موزع عليها 27 زر أمر وأريد ضبط الكود لتوزيع الصور التي بالجدول

Restaurant.rar

قام بنشر

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

قام بنشر

السلام عليكم 🙂

 

انا عملت تغيير في النموذج ، واصبح بسيط :

image.png.fd7511de4a773706298501ee7e8ca1fa.png

.

بس هذه طريقة المجلدات 

image.png.83c109ad7cedc1712a1203b004ea9042.png

.

كود النموذج الرئيسي:

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

.

 

ولما تنقر على اي من ازرار النموذج الفرعي ، تحصل على

image.png.8b499ba3fa0a935e76ec17fd9d8904a9.png

.

وكود النموذج الفرعي:

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

  • Like 2
قام بنشر

كما عودتنا على الابداع دائما مبدع وماشاء الله عليك يا برفيسور جعفر شكرا جزيلا وبارك الله فيك عمل أكثر من رائع👍

قام بنشر

حياك الله 🙂

 

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

السبب في احتياجه هو ، عندما نختار مادة وتظهر لنا رسالة بياناتها (طبعا انت لن تستعمل الرسالة ، وانما ستستخدم بياناتها 🙂) ، فلا تستطيع ان تختار من القائمة الرئيسية مرة اخرى :

image.png.6de57a2dec96d8b84739ae3709befc0f.png

.

واما في الكود ، فقد تم اضافته في كود النموذج الفرعي ، هكذا:

image.png.2118228de88be76d61575b2d7621e08a.png

.

جعفر

1321.1.RestTest111.accdb.zip

  • Thanks 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information