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

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

السلام عليكم

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

وعند حدف صورة حتى نخرج من نموذج DDCompanyLogos.rar

[منتصر الانسي]

من إطلاعي على الملف فأنت تريد أن الصور التي بإسم CompanyLogo و StampLogo أن تكون عامة لكل الفروع والصور BranchLogo تكون متغيرة بحسب الفرع أليس كذلك؟

إذا كان الوضع بهذا الشكل فيجب عليك عدم ربط الصورتين CompanyLogo و StampLogo بالحقل لأنه يفترض أن الشركة واحدة 

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

هل هذا التعديل هو ماتطلبه أم شيئ آخر لأن شرحك غير واضح

مع تحياتي

DDCompanyLogos.rar

 

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

اقتباس

السلام عليكم

اخي الفاضل لقد وقع خطا في وضع الملف

اليك الملف

اريد اضافة التعديل على اسم الصورة فقط

 

الصورة.rar

[Foksh]

28 دقائق مضت, بلال اليامين said:

 

الصورة.rar 114.5 kB · 1 download

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

ثانياً لا أعتقد أنها صدفة للبيانات التي في السجل الوحيد في الجدول 😅😅

الإسم وتاريخ الميلاد ، والوظيفة 🤔 = جميعها تخصني ( هي ليست سرية ، ولكني استغربت 😁 )

على العموم ، ومشاركة مع معلمي الأستاذ @منتصر الانسي :-

لاحظت انك استخدمت تكرار المتغير m مرات عديدة في جميع الأجزاء ، ولذا أقترح عليك ان تقوم بتعريفه كمتغير في بداية النموذج لتخزين مسار الملفات . وهذا مقترحي كاملاً بعد إجراء بعض التغييرات :-

 

Option Compare Database

Private m_ImagePath As String

Sub ImageLoad()
    On Error Resume Next
    m_ImagePath = CurrentProject.Path & "\" & "SysFiles" & "\" & Me.ID
    List31.RowSource = ""
    List31.RowSource = Left(GetAllFile(m_ImagePath), Len(GetAllFile(m_ImagePath)) - 1)
End Sub

Private Sub Command42_Click()
    On Error Resume Next
    m_ImagePath = CurrentProject.Path & "\SysFiles\" & Me.ID
    Dim newFileName As String
    newFileName = AddNewFile(Me.ID)
    Image16.Picture = m_ImagePath & "\" & newFileName
    Call ImageLoad
    Me.Path = m_ImagePath & "\" & newFileName
    If Not IsNull(newFileName) Then
        List31.Value = newFileName
    End If
End Sub

Private Sub Command43_Click()
    On Error Resume Next
    If IsNull(List31) Then Exit Sub
    If MsgBox("هل تريد فعلا حذف الصورة المحددة" & vbNewLine & List31, vbMsgBoxRight + vbYesNo + vbQuestion, "تأكيد الحذف") = vbYes Then
        m_ImagePath = CurrentProject.Path & "\" & "SysFiles" & "\" & Me.ID
        Kill (m_ImagePath & "\" & List31)
        Call ImageLoad
        Image16.Picture = ""
        Image16.Requery
    End If
End Sub

Private Sub Form_Current()
    On Error Resume Next
    Call ImageLoad
    Me.Form.Caption = IIf(IsNull(Me.الاسم), "", Me.الاسم)
    Image16.Picture = ""
    Auto_Header0.Caption = "الأرشيف الالكتروني للموظف" & " : " & Me.الاسم
End Sub

Private Sub List31_Click()
    On Error Resume Next
    m_ImagePath = CurrentProject.Path & "\" & "SysFiles" & "\" & Me.ID
    Image16.Picture = m_ImagePath & "\" & List31
    Me.Path = m_ImagePath & "\" & Me.List31
End Sub

 

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

اخي اين اضع الكود

اريد تعديل على اسم الصورة 

تم تعديل منذ 3 ساعات بواسطه بلال اليامين

[Foksh]

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

اريد تعديل على اسم الصورة 

لم تقم بتوضيح ماذا تريد ان يكون اسم الصورة ؟

رقم الموظف مثلاً !!!

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

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

ادراج حقل لكتابة اسم الصورة 

تم تعديل منذ 2 ساعات بواسطه بلال اليامين

[Foksh]

1 دقيقه مضت, بلال اليامين said:

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

بصراحة ما فهمت

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

اليك التوضح

[Foksh]

ما في مشكلة أخي الكريم ، بس سؤالنا ؟

ماذا تريد ان يكون اسم الصورة عند اختيارها ؟؟؟؟؟؟؟؟

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

يكون اسم الصورة عند اختيارها ونقوم بتعديل

تم تعديل منذ 1 ساعه بواسطه بلال اليامين

[Foksh]

14 دقائق مضت, بلال اليامين said:

يكون اسم الصورة عند اختيارها ونقوم بتعديل

اخوي بلال ، من باب التوضيح أكثر لك .

انت تريد عند النقر مرتين على اسم الصورة ان يتم اظهار رسالة تكتب فيها اسم الصورة الذي تريده ؟؟؟

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

نعم اخي الفاضل

[Foksh]

تمام ، هكذا الأمور أوضح للجميع ,,

تفضل هذا الكود كاملاً للنموذج بعد التعديل :-
 

Option Compare Database

Private m_ImagePath As String

Sub ImageLoad()
    On Error Resume Next
    m_ImagePath = CurrentProject.Path & "\" & "SysFiles" & "\" & Me.ID
    List31.RowSource = ""
    List31.RowSource = Left(GetAllFile(m_ImagePath), Len(GetAllFile(m_ImagePath)) - 1)
End Sub

Private Sub Command42_Click()
    On Error Resume Next
    m_ImagePath = CurrentProject.Path & "\SysFiles\" & Me.ID
    Dim newFileName As String
    newFileName = AddNewFile(Me.ID)
    Image16.Picture = m_ImagePath & "\" & newFileName
    Call ImageLoad
    Me.Path = m_ImagePath & "\" & newFileName
    If Not IsNull(newFileName) Then
        List31.Value = newFileName
    End If
End Sub

Private Sub Command43_Click()
    On Error Resume Next
    If IsNull(List31) Then Exit Sub
    If MsgBox("هل تريد فعلا حذف الصورة المحددة" & vbNewLine & List31, vbMsgBoxRight + vbYesNo + vbQuestion, "تأكيد الحذف") = vbYes Then
        m_ImagePath = CurrentProject.Path & "\" & "SysFiles" & "\" & Me.ID
        Kill (m_ImagePath & "\" & List31)
        Call ImageLoad
        Image16.Picture = ""
        Image16.Requery
    End If
End Sub

Private Sub Form_Current()
    On Error Resume Next
    Call ImageLoad
    Me.Form.Caption = IIf(IsNull(Me.الاسم), "", Me.الاسم)
    Image16.Picture = ""
    Auto_Header0.Caption = "الأرشيف الالكتروني للموظف" & " : " & Me.الاسم
End Sub

Private Sub List31_Click()
    On Error Resume Next
    m_ImagePath = CurrentProject.Path & "\" & "SysFiles" & "\" & Me.ID
    Image16.Picture = m_ImagePath & "\" & List31
    Me.Path = m_ImagePath & "\" & Me.List31
End Sub

Private Sub List31_DblClick(Cancel As Integer)
    On Error Resume Next
    If IsNull(List31.Value) Or List31.Value = "" Then Exit Sub
    Dim oldName As String, oldNameWithoutExt As String, fileExt As String
    Dim filePath As String, newName As String, newNameWithExt As String
    oldName = List31.Value
    filePath = CurrentProject.Path & "\SysFiles\" & Me.ID & "\"
    Dim dotPosition As Integer
    dotPosition = InStrRev(oldName, ".")
    If dotPosition > 0 Then
        oldNameWithoutExt = Left(oldName, dotPosition - 1)
        fileExt = Mid(oldName, dotPosition)
    Else
        oldNameWithoutExt = oldName
        fileExt = ""
    End If
    newName = InputBox("أدخل الاسم الجديد للصورة", "تعديل اسم الصورة", oldNameWithoutExt)
    If newName = "" Or newName = oldNameWithoutExt Then Exit Sub
    newNameWithExt = newName & fileExt
    If Dir(filePath & oldName) <> "" Then
        If Dir(filePath & newNameWithExt) <> "" And LCase(filePath & newNameWithExt) <> LCase(filePath & oldName) Then
            MsgBox "! يوجد ملف بهذا الاسم بالفعل", vbExclamation + vbMsgBoxRight, ""
            Exit Sub
        End If
        Name filePath & oldName As filePath & newNameWithExt
        Call ImageLoad
        List31.Value = newNameWithExt
        If Image16.Picture = filePath & oldName Then
            Image16.Picture = filePath & newNameWithExt
            Me.Path = filePath & newNameWithExt
        End If
        MsgBox "تم تعديل اسم الصورة بنجاح", vbInformation + vbMsgBoxRight, ""
    Else
        MsgBox "الصورة التي تحاول تغيير اسمها ، غير موجودة في مجلد الموظف", vbExclamation + vbMsgBoxRight, ""
    End If
End Sub

 

الملف :-


 

الصورة.zip