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

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

قام بنشر

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

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

  • Thanks 1
قام بنشر (معدل)
2 دقائق مضت, محمد احمد لطفى said:

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


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

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

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

تم تعديل بواسطه ابا جودى
  • Thanks 1
قام بنشر

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

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

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

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

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

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

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

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

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

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

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

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

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

  • Thanks 1
قام بنشر (معدل)

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

Photo.rar

تم تعديل بواسطه محمد احمد لطفى
قام بنشر

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

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

 

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"
 

Capture.JPG

Capture55.JPG

قام بنشر
7 ساعات مضت, محمد احمد لطفى said:

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

ممتاز :clapping:

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

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

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

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

  • Like 1
  • Thanks 1
قام بنشر (معدل)

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

عند تغيير 
 

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

لم يحدث مشاكل 

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

تم تعديل بواسطه محمد احمد لطفى
قام بنشر
منذ ساعه, محمد احمد لطفى 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

 

قام بنشر (معدل)

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

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

تم تعديل بواسطه محمد احمد لطفى
قام بنشر
4 دقائق مضت, محمد احمد لطفى said:

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

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

  • Thanks 1
قام بنشر
58 دقائق مضت, محمد احمد لطفى said:

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

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

Worker.mdb

 

  • Thanks 1
قام بنشر (معدل)

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

 

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

 

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

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

تم تعديل بواسطه محمد احمد لطفى
قام بنشر
22 دقائق مضت, محمد احمد لطفى said:

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

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

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

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

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

  • Thanks 1
قام بنشر (معدل)

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

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

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

ارجو التعديل على الكود التالى أن يحذف الامتداد  (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

 

تم تعديل بواسطه محمد احمد لطفى
  • Haha 1
قام بنشر
7 دقائق مضت, محمد احمد لطفى said:

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

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

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

  • Like 1
  • Thanks 1
قام بنشر
10 دقائق مضت, أبو إبراهيم الغامدي said:

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

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

ان شاء الله

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