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

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

بلال اليامين

بواسطه بلال اليامين
في قسم الأكسيس Access

 مشاركة
إذهب إلى الإجابة الإجابة بواسطة Foksh,

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

منتصر الانسي

منتصر الانسي

قام بنشر
قام بنشر

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

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

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

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

مع تحياتي

DDCompanyLogos.rar

 

Foksh

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

 

Foksh

Foksh

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

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

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

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

Foksh

Foksh

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

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

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

Foksh

Foksh

قام بنشر
قام بنشر

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

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

Foksh

Foksh

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

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

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

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

  • تمت الإجابة
Foksh

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

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept