امكانية دمج نوعين من اكواد الصور ليصبح كود واحد

[محمد التميمي]

 

السلام عليكم

في الملف المرفق يوجد نموذج يعرض صور الموظفين على شكل صورة جديدة وصورة قديمة. طبعا كود جلب الصورة الجديدة عن طريق زر الامر باسم (إضافة صورة).

اما كود جلب الصورة القديمة فهو موجود بالنموذج خلال عرض تصميم (في الحالي).

المطلوب اساتذتي الكرام :-

   ((في حال دمج اعمدة الصور في الجدول عامود الصور القديمة مثل (زكي درويش. jpg) و عامود الصور الجديد في عامود واحد كما موضح في الصورة ادناه.))

*-  هل بالإمكان دمج اكود الصور ليصبح كود واحد وإلغاء أحد المربعات العارضة للصور في النموذج ليصبح مربع صورة واحدة فقط مع الاحتفاظ بميزة الكود ( جلب صورة جديدة). والغاء فولدرات الصور عدد 2 الخارجية ليكون فولدر واحد يحوي الصور.

 

مع فائق الشكر والاحترام

 

 

555.rar

555.rar

تم تعديل الأحد at 10:29 بواسطه محمد التميمي

[kanory]

في 19‏/1‏/2025 at 12:09, محمد التميمي said:

هل بالإمكان دمج اكود الصور ليصبح كود واحد وإلغاء أحد المربعات العارضة للصور في النموذج ليصبح مربع صورة واحدة فقط مع الاحتفاظ بميزة الكود ( جلب صورة جديدة). والغاء فولدرات الصور عدد 2 الخارجية ليكون فولدر واحد يحوي الصور.

اصنع زر في النموذج لديك ثم ادرج هذا الكود فيه ...............

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim oldPicPath As String
    Dim newPicPath As String
    Dim FirstName As String
    Dim keyVal As String
    Dim desktopPath As String
    Dim sourceFolder As String
    Dim destFolder As String
    Dim fileSystem As Object
    
    desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    sourceFolder = desktopPath & "\555\Pic1\" ' المجلد المصدر
    destFolder = desktopPath & "\555\Pictures\" ' المجلد الوجهة
    
    Set fileSystem = CreateObject("Scripting.FileSystemObject")
    
    If Not fileSystem.FolderExists(destFolder) Then
        fileSystem.CreateFolder destFolder
    End If
    
    Set db = CurrentDb
    
    Set rs = db.OpenRecordset("Table1", dbOpenDynaset)
    
    Do While Not rs.EOF
        If IsNull(rs!Pic2) Or rs!Pic2 = "" Then
            FirstName = rs!FirstName
            keyVal = rs!Key
            
            If Not IsNull(FirstName) And Not IsNull(keyVal) Then
                oldPicPath = sourceFolder & FirstName & ".jpg"
                
                newPicPath = destFolder & keyVal & ".jpg"
                
                If fileSystem.FileExists(oldPicPath) Then
                    fileSystem.MoveFile oldPicPath, newPicPath
                    
                    rs.Edit
                    rs!Pic2 = newPicPath
                    rs.Update
                End If
            End If
        End If
        rs.MoveNext
    Loop
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Set fileSystem = Nothing
    
    MsgBox "تم نقل الصور وتحديث الحقل Pic2 بنجاح", vbInformation

 

[محمد التميمي]

2 ساعات مضت, kanory said:

اصنع زر في النموذج لديك ثم ادرج هذا الكود فيه ...............

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim oldPicPath As String
    Dim newPicPath As String
    Dim FirstName As String
    Dim keyVal As String
    Dim desktopPath As String
    Dim sourceFolder As String
    Dim destFolder As String
    Dim fileSystem As Object
    
    desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    sourceFolder = desktopPath & "\555\Pic1\" ' المجلد المصدر
    destFolder = desktopPath & "\555\Pictures\" ' المجلد الوجهة
    
    Set fileSystem = CreateObject("Scripting.FileSystemObject")
    
    If Not fileSystem.FolderExists(destFolder) Then
        fileSystem.CreateFolder destFolder
    End If
    
    Set db = CurrentDb
    
    Set rs = db.OpenRecordset("Table1", dbOpenDynaset)
    
    Do While Not rs.EOF
        If IsNull(rs!Pic2) Or rs!Pic2 = "" Then
            FirstName = rs!FirstName
            keyVal = rs!Key
            
            If Not IsNull(FirstName) And Not IsNull(keyVal) Then
                oldPicPath = sourceFolder & FirstName & ".jpg"
                
                newPicPath = destFolder & keyVal & ".jpg"
                
                If fileSystem.FileExists(oldPicPath) Then
                    fileSystem.MoveFile oldPicPath, newPicPath
                    
                    rs.Edit
                    rs!Pic2 = newPicPath
                    rs.Update
                End If
            End If
        End If
        rs.MoveNext
    Loop
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Set fileSystem = Nothing
    
    MsgBox "تم نقل الصور وتحديث الحقل Pic2 بنجاح", vbInformation

 

السلام عليكم استاذي الفاضل:

بعد انشاء زر الامر  / تم تحديث المسارات القديمة الى مسارات جديدة وتمت العملية بنجاح جزاكم الله خيرا...

هذا بالنسبة الى المثال الصغير عندي

وساعمل انشاء الله على قاعدة البيانات الاصلية واوفيكم بالنتيجة

علما انه عندي ما يقارب 46000 الف امتداد قديم (بالاسم) و 21000 امتداد جديد جميعها في قاعدة بيانات واحدة.

بارك الله بجهودكم....

 

[kanory]

8 دقائق مضت, محمد التميمي said:

بعد انشاء زر الامر  / تم تحديث المسارات القديمة الى مسارات جديدة وتمت العملية بنجاح جزاكم الله خيرا...

ممكن الاستغناء عن إضافة المسارات في الجدول ويتم عرضها من المجلد مباشرة بمعرفة الرقم فقط

[محمد التميمي]

منذ ساعه, kanory said:

ممكن الاستغناء عن إضافة المسارات في الجدول ويتم عرضها من المجلد مباشرة بمعرفة الرقم فقط

السلام عليكم:

مع الاسف استاذي المحترم لم تنجح العملية تظهر لي الرسالة ادناه.

 

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

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

بوركت وسلمت يداك