دمج الصور في تقرير واحد

[بلال اليامين]

السلام عليكم

لدي مجموعة من الصور اريد جمعها في تقرير واحد

و اريد عند لا يوجد صور في التقرير  لايفتح 

الصورة (1).rar

[Foksh]

وعليكم السلام ورحمة الله وبركاته ..

تم إضافة دالة جديدة لإنشاء الجدول المؤقت الجديد "zTempImageReport" ، حيث يتم فيه اضافة سجلات الصور ومساراتها :-

Public Function CreateTempImageTable()
    On Error GoTo ErrorHandler
    
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim tblExists As Boolean
    
    Set db = CurrentDb()
    tblExists = False
    
    For Each tdf In db.TableDefs
        If tdf.Name = "zTempImageReport" Then
            tblExists = True
            Exit For
        End If
    Next tdf
    
    If Not tblExists Then
        Set tdf = db.CreateTableDef("zTempImageReport")
        
        Set fld = tdf.CreateField("ImageName", dbText, 255)
        tdf.Fields.Append fld
        
        Set fld = tdf.CreateField("ImagePath", dbText, 255)
        tdf.Fields.Append fld
        
        Set fld = tdf.CreateField("EmployeeID", dbLong)
        tdf.Fields.Append fld
        
        Set fld = tdf.CreateField("EmployeeName", dbText, 100)
        tdf.Fields.Append fld
        
        db.TableDefs.Append tdf
    Else
        db.Execute "DELETE * FROM zTempImageReport", dbFailOnError
    End If
    
    Exit Function
    
ErrorHandler:
    MsgBox " : حدث خطأ في إعداد الجدول المؤقت" & Err.Description, vbCritical + vbMsgBoxRight, ""
    Exit Function
End Function

 

قمت بإنشاء التقرير "rptImageGallery" ، والذي مصدر سجلاته = الجدول المؤقت السابق "zTempImageReport" ، وفي النموذج في الزر "أمر105" الكود التالي :-

Private Sub أمر105_Click()
    On Error GoTo ErrorHandler
    If List31.ListCount = 0 Then
        MsgBox "لا توجد صور ليتم عرضها في التقرير", vbInformation + vbMsgBoxRight, ""
        Exit Sub
    End If
    Call CreateTempImageTable
    
    Dim db As DAO.Database
    Dim rs As Recordset
    Dim i As Integer
    Dim ImagePath As String
    Dim basePath As String
    
    basePath = CurrentProject.Path & "\SysFiles\" & Me.ID & "\"
    Set db = CurrentDb()
    
    db.Execute "DELETE * FROM zTempImageReport", dbFailOnError
    
    For i = 0 To List31.ListCount - 1
        If List31.ItemData(i) <> "" Then
            ImagePath = basePath & List31.ItemData(i)
            
            If Dir(ImagePath) <> "" Then
                db.Execute "INSERT INTO zTempImageReport " & _
                           "(ImageName, ImagePath, EmployeeID, EmployeeName) " & _
                           "VALUES ('" & Replace(List31.ItemData(i), "'", "''") & "', " & _
                           "'" & Replace(ImagePath, "'", "''") & "', " & _
                           Me.ID & ", '" & Replace(Me.الاسم, "'", "''") & "')", dbFailOnError
            End If
        End If
    Next i
    
    DoCmd.OpenReport "rptImageGallery", acViewPreview
    
    Exit Sub
    
ErrorHandler:
    MsgBox " : حدث خطأ أثناء فتح التقرير" & Err.Description, vbCritical + vbMsgBoxRight, ""
End Sub

 

هي فكرة بسيطة تلبي حاجتك ، وتستطيع التعديل عليها حسب حاجتك .

الملف بعد التعديل :-

 

الصورة (1).zip

[بلال اليامين]

اخي الفاضل

نسيت اضافة عند كل صورة اريد اظهار  * تمت عملية تحميل الصورة بنجاح: هنا اسم الصورة*

وتظهر هذه الكلمة امام كل صورة بالون الاخضر

با رك الله فيك

[Foksh]

9 ساعات مضت, بلال اليامين said:

نسيت اضافة عند كل صورة اريد اظهار  * تمت عملية تحميل الصورة بنجاح: هنا اسم الصورة*

جزاك الله كل خير على ما اضحكت به قلبي 😂

لماذا تبحث عن كل هذا التعقيد 🤔 !!؟

أولا الليست بوكس لا يتم إضافة أسماء الصور إلا تلك التي يتم فعلاً إختيارها وإضافتها بنجاح.

ثانياً ، لا تستطيع تلوين جزء من قيمة صف في الليست بوكس كما تفكر .

ثالثاً ، إذا فكرت في إضافة هذه الجملة ، فسيكون عملك أكبر بحيث أنه عند اختيار أي صورة لعرضها ، فسيعمل الكود على اجتزاء اسم الصورة أولاً ثم عرضها ..... وناهيك عن إحتمالية حدوث الأخطاء.

رابعاً ، البساطة في الأفكار جميلة إن كان يمكن تحقيقها بسهولة ، أو حتى لو بالحيلة . لكن في طلبك فإن مارد الفانوس قد استغرب من الطلب 😜 .

 

أرجو أن تكون الفكرة قد توضحت.