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

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

 

السلام عليكم

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

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

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

   ((في حال دمج اعمدة الصور في الجدول عامود الصور القديمة مثل (زكي درويش. 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:

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

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

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

 

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

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

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

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

12 ساعات مضت, محمد التميمي said:

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

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

 

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

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

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

السلام عليكم .. اسعد الله صباحكم بكا خير

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

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

جزاك الله الف خير وجعلها في ميزان حسناتك عند الله

شكرا جزيلا

[kanory]

6 ساعات مضت, محمد التميمي said:

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

دائما ابحث عن حل كامل لمشاكل برامجك .... لا ترضي بانصاف الحلول  ..... لو عرضت لنا تلك المسميات لربما تجد الحل من احد اعضاء المنتدى فيصبح لديك حل 100 %

6 ساعات مضت, محمد التميمي said:

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

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

 

555.rar

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

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

دائما ابحث عن حل كامل لمشاكل برامجك .... لا ترضي بانصاف الحلول  ..... لو عرضت لنا تلك المسميات لربما تجد الحل من احد اعضاء المنتدى فيصبح لديك حل 100 %

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

 

555.rar 303.41 kB · 5 downloads

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