تعديل اسم الصورة على الحاسب عند تعديله فى النموذج

[محمد احمد لطفى]

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

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

وجزاكم الله خيراً

Photo.rar

[محمد احمد لطفى]

للرفع

[ابو جودي]

عاوز التعديل على المرفق ده واللا على المرفق الرئيسى الاخر اللى منت تريد اظهار الامتداد به داهل الاستعلام 

وانتبه هنا نتعامل مع نموذج مفرد رئيسي اما هناك مع نموذج فرعى 

[محمد احمد لطفى]

أستاذى @ابا جودى

اذا كان هناك نموذج فرعى نستطيع عمل استعلام تحديث الاسم

أما الان التعديل على النموذج المرفق 
 

[ابو جودي]

2 دقائق مضت, محمد احمد لطفى said:

أستاذى @ابا جودى

اذا كان هناك نموذج فرعى نستطيع عمل استعلام تحديث الاسم

أما الان التعديل على النموذج المرفق 
 

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

تم تعديل يوليو 1, 2019 بواسطه ابا جودى

[محمد احمد لطفى]

نعم استاذى

[محمد احمد لطفى]

للرفع قد يساعد 
 

To Change the Name of the Attachment in Access

Private Sub Command15_Click()
    Dim NewName As String
    Dim NewNameWithExt As String

    NewName = Me.TestID.Value

    NewNameWithExt = NewName & ".txt"

    DoCmd.RunSQL ("UPDATE TestTable SET TestAttachment.FileName = '" & 
    NewNameWithExt & "' WHERE TestID = " & NewName)

End Sub

To Change the Name of the File on the Desktop

 

Private Sub Command0_Click()
    Dim NewName As String
    Dim OldName As String
    Dim rs As Object
    Dim strSQL As String

    Set rs = CreateObject("ADODB.Recordset")

    strSQL = "SELECT TestAttachment.FileName FROM TestTable WHERE TestID = 1"

    rs.Open strSQL, CurrentProject.Connection, 1, 3

    Do Until rs.EOF
        OldName = rs.Fields(0)
        NewName = CurrentDb.TableDefs("TestTable").Fields(0).Name

        Name "C:\Users\TestUser\desktop\" & OldName As 
        "C:\Users\TestUser\desktop\" & NewName & ".TXT"

        rs.MoveNext
    Loop

    rs.Close
    Set rs = Nothing

End Sub

و موضوع اخر 

https://www.devhut.net/2010/09/27/ms-access-vba-rename-file/

و موضوع أخر 

Do Loop for renaming files in folder

وموضوع اخر 

MS Access VBA loop through query and rename files

 

موضوع اخر 

Rename files from VBA based on a query

معنديش خبرة للاسف انى أطبق

[أبو إبراهيم الغامدي]

أهلا بك @محمد احمد لطفى

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

Photo.zip

[محمد احمد لطفى]

2 ساعات مضت, أبو إبراهيم الغامدي said:

أهلا بك @محمد احمد لطفى

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

Photo.zip 743.05 \u0643\u064a\u0644\u0648 \u0628\u0627\u064a\u062a · 1 download

جزاك الله خيرا استاذى @أبو إبراهيم الغامدي

أرى انها تعمل اذا كانت الصور فى نفس الملف ولكن اذا كانت الصور فى ملف أخر كيف يصبح الامر

[أبو إبراهيم الغامدي]

29 دقائق مضت, محمد احمد لطفى said:

أرى انها تعمل اذا كانت الصور فى نفس الملف ولكن اذا كانت الصور فى ملف أخر كيف يصبح الامر

الخصيصة: CurrentProject.Path تعيد المسار الافتراضي للمشورع الحالي (قاعدة البيانات)..

قم بتغييرها بمسارك المفضل للصور 

[محمد احمد لطفى]

أستاذى @أبو إبراهيم الغامدي
ممكن أستأذن حضرتك تغيرها ذى ما موجودة بالمثال الاخير لانى معنديش خبرة كويسة فى الاكواد و منها نتعلم

Photo.rar

تم تعديل يوليو 3, 2019 بواسطه محمد احمد لطفى

[محمد احمد لطفى]

أستاذى @أبو إبراهيم الغامدي

تم تغيير الكود 
الى 

 

Private Sub Form_Current()
On Error GoTo errresult
  Dim ErrImage As String
  Dim CurImage As String
  
  ErrImage = "D:\Photo\123\No.jpg"
  CurImage = "D:\Photo\123\" & Me.Worker & ".jpg"
  Me.imgWorker.Picture = CurImage
errresult:
  If Err.Number = 2220 Then
      Me.imgWorker.Picture = ErrImage
      Resume Next
  End If
End Sub


'D:\Photo\123

Private Sub Worker_BeforeUpdate(Cancel As Integer)
  Dim OldImage As String
  Dim NewImage As String
  
  OldImage = Me.imgWorker.Picture
  NewImage = "D:\Photo\123\" & Me.Worker & ".jpg"
  
  If Dir(OldImage) = "No.jpg" Then
    Me.imgWorker.Picture = NewImage
  ElseIf Len(Dir(NewImage)) > 0 Then
    MsgBox Dir(NewImage) & vbNewLine & "يوجد صورة سابقة بنفس الاسم..", _
    vbMsgBoxRight + vbMsgBoxRtlReading, "تنبيه"
    Me.Undo
  Else
    Name OldImage As NewImage
    Me.imgWorker.Picture = NewImage
  End If
End Sub

تبقى عند تغيير اسم لا يوجد له صورة يأتى خطأ و اذا امكن حذف الامتداد حيث هناك صور "jpeg"
 

[أبو إبراهيم الغامدي]

7 ساعات مضت, محمد احمد لطفى said:

تم تغيير الكود 

ممتاز 

بالنسبة للخطأ فهذا حدث بسبب أن السجل الحالي يقف على سجل جديد!

لمعالجة هذه المشكلة نحن بحاجة إلى أمرين 

الأول.. الجزء الأصفر من الشفرة غير NewImage إلى OldImage 

الثاني.. وهو المهم إضافة حقل المعرف Id والسبب لأنك تعمل على استعلام مدمج ومعرف الدمج غير مضاف في النموذج

[محمد احمد لطفى]

جزاك الله خيراً أستاذى @أبو إبراهيم الغامدي

عند تغيير 
 

الأول.. الجزء الأصفر من الشفرة غير NewImage إلى OldImage 

لم يحدث مشاكل 

هل يمكن حذف الامتداد حيث هناك صور "jpeg" أو Png 

تم تعديل يوليو 3, 2019 بواسطه محمد احمد لطفى

[أبو إبراهيم الغامدي]

منذ ساعه, محمد احمد لطفى said:

هل يمكن حذف الامتداد حيث هناك صور "jpeg" أو Png

نعم.. 

استخدم هذه الشفرة.. مع ملاحظة الفروق

 
Private Sub Form_Current()
On Error GoTo errresult
  Dim ErrImage As String
  Dim CurImage As String
  Dim ImageName as String
  
  ImageName=Dir("D:\Photo\123\" & Me.Worker & ".*")
  ErrImage = "D:\Photo\123\No.jpg"
  CurImage = "D:\Photo\123\" & ImageName
  Me.imgWorker.Picture = CurImage
errresult:
  If Err.Number = 2220 Then
      Me.imgWorker.Picture = ErrImage
      Resume Next
  End If
End Sub


'D:\Photo\123

Private Sub Worker_BeforeUpdate(Cancel As Integer)
  Dim OldImage As String
  Dim NewImage As String
  Dim ImageName as String
  
  ImageName=Dir("D:\Photo\123\" & Me.Worker & ".*")
  OldImage = Me.imgWorker.Picture
  NewImage = "D:\Photo\123\" & ImageName
  
  If Dir(OldImage) = "No.jpg" Then
    Me.imgWorker.Picture = NewImage
  ElseIf Len(Dir(NewImage)) > 0 Then
    MsgBox Dir(NewImage) & vbNewLine & "يوجد صورة سابقة بنفس الاسم..", _
    vbMsgBoxRight + vbMsgBoxRtlReading, "تنبيه"
    Me.Undo
  Else
    Name OldImage As NewImage
    Me.imgWorker.Picture = NewImage
  End If
End Sub

 

[محمد احمد لطفى]

أستاذى @أبو إبراهيم الغامدي

 

ظهرت هذه الصورة عند تغيير الاسم لموظف له صورة

 

 

تم تعديل يوليو 3, 2019 بواسطه محمد احمد لطفى

[أبو إبراهيم الغامدي]

29 دقائق مضت, محمد احمد لطفى said:

ظهرت هذه الصورة عند تغيير الاسم لموظف له صورة

أسف لهذا الغلط.. عندما عدلت الشفرة نسيت أن أعدل هذا ..

[محمد احمد لطفى]

أستاذى @أبو إبراهيم الغامديانا عدلتها 

عند تغيير اسم ليس له صورة لا تحدث مشكلة  ..., ولكن تحدث مع الصور التى لها صورة

تم تعديل يوليو 3, 2019 بواسطه محمد احمد لطفى

[أبو إبراهيم الغامدي]

4 دقائق مضت, محمد احمد لطفى said:

الصور الى ليس لها صورة لا تحدث مشكلة  ..., ولكن تحدث مع الصور التى لها صورة

سوف أرجع إلى قاعدة البيانات وأتحقق من القصور,,

[أبو إبراهيم الغامدي]

58 دقائق مضت, محمد احمد لطفى said:

الصور الى ليس لها صورة لا تحدث مشكلة  ..., ولكن تحدث مع الصور التى لها صورة

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

Worker.mdb

 

[محمد احمد لطفى]

أستاذى العزيز @أبو إبراهيم الغامدي

 

الان عند تغيير الاسم له صورة لا يغيير اسم الصورة

 

Private Sub Form_Current()
On Error GoTo errresult
  Dim ErrImage As String
  Dim CurImage As String
  
  ErrImage = "D:\Photo\123\No.jpg"
  CurImage = "D:\Photo\123\" & Me.Worker & ".jpg"
  Me.imgWorker.Picture = CurImage
errresult:
  If Err.Number = 2220 Then
      Me.imgWorker.Picture = ErrImage
      Resume Next
  End If
End Sub


'D:\Photo\123

Private Sub Worker_BeforeUpdate(Cancel As Integer)
  Dim OldImage As String
  Dim NewImage As String
  
  OldImage = Me.imgWorker.Picture
  NewImage = "D:\Photo\123\" & Me.Worker & ".jpg"
  
  If Dir(OldImage) = "No.jpg" Then
    Me.imgWorker.Picture = OldImage
  ElseIf Len(Dir(NewImage)) > 0 Then
    MsgBox Dir(NewImage) & vbNewLine & "يوجد صورة سابقة بنفس الاسم..", _
    vbMsgBoxRight + vbMsgBoxRtlReading, "تنبيه"
    Me.Undo
  Else
    Name OldImage As NewImage
    Me.imgWorker.Picture = NewImage
  End If
End Sub

هذا كان يعمل و المشكلة حدثت عندما حذفنا نوع ملف الصورة

تم تعديل يوليو 3, 2019 بواسطه محمد احمد لطفى

[أبو إبراهيم الغامدي]

22 دقائق مضت, محمد احمد لطفى said:

هذا كان يعمل و المشكلة حدثت عندما حذفنا نوع ملف الصورة

ليس صحيحا! الشفرة كانت ناقصة!

إذا كان هناك صورة اسمها (محمد.jpg) وأردت أن تغير اسم أحمد إلى محمد فإن صورة أحمد بالتالي سيتغير اسمها إلى محمد؛ وهذا يعني وجود صورتين بنفس الاسم في مجلد واحد!

وهذا منطقيا غير مقبول.

وإذا كان الخطأ في الاسم فقط فلابد من وجود رسالها تخير المستخدم بقبول تغيير الاسم من عدمه ولهذا أرفقت لك التعديل

[محمد احمد لطفى]

أستاذى @أبو إبراهيم الغامدي

اولا سوف أقوم بمنع التكرار و هو موجود بالفعل فى النموذج الذى اعمل عليه 

ثانيا النموذج الاخير يقوم بتغيير الاسم فقط و لا يقوم بتغيير الصورة 

ارجو التعديل على الكود التالى أن يحذف الامتداد  (jpg)حيث هناك صور "jpeg" أو Png فقط
 

Private Sub Form_Current()
On Error GoTo errresult
  Dim ErrImage As String
  Dim CurImage As String
  
  ErrImage = "D:\Photo\123\No.jpg"
  CurImage = "D:\Photo\123\" & Me.Worker & ".jpg"
  Me.imgWorker.Picture = CurImage
errresult:
  If Err.Number = 2220 Then
      Me.imgWorker.Picture = ErrImage
      Resume Next
  End If
End Sub


'D:\Photo\123

Private Sub Worker_BeforeUpdate(Cancel As Integer)
  Dim OldImage As String
  Dim NewImage As String
  
  OldImage = Me.imgWorker.Picture
  NewImage = "D:\Photo\123\" & Me.Worker & ".jpg"
  
  If Dir(OldImage) = "No.jpg" Then
    Me.imgWorker.Picture = OldImage
  ElseIf Len(Dir(NewImage)) > 0 Then
    MsgBox Dir(NewImage) & vbNewLine & "يوجد صورة سابقة بنفس الاسم..", _
    vbMsgBoxRight + vbMsgBoxRtlReading, "تنبيه"
    Me.Undo
  Else
    Name OldImage As NewImage
    Me.imgWorker.Picture = NewImage
  End If
End Sub

 

تم تعديل يوليو 3, 2019 بواسطه محمد احمد لطفى

[أبو إبراهيم الغامدي]

7 دقائق مضت, محمد احمد لطفى said:

ارجو التعديل على الكود فى المشاركة السابقة أن يحذف الامتداد  (jpg)حيث هناك صور "jpeg" أو Png فقط

ليس الخطأ في استخدام اللاحقة العائمة! بل لكوني مشوش الفكر قليلا ولم استطع التركيز على ضبط منطق الشفرة!

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

[محمد احمد لطفى]

10 دقائق مضت, أبو إبراهيم الغامدي said:

ليس الخطأ في استخدام اللاحقة العائمة! بل لكوني مشوش الفكر قليلا ولم استطع التركيز على ضبط منطق الشفرة!

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

ان شاء الله