نقل صورة من مكان الى مكان "JPEG" و "PNG" و ".jpg"

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

 

أريد نقل صورة من مكان الى مكان المشكلة فى امتداد الصورة فى هذا السطر
 

oldpathANDname = CurrentProject.Path & "\download\" & [id] & ".jpg"

المشكلة أنه ينقل الصور امتداد ".jpg" فقط 

أرجو التعديل يشمل 

"JPEG" و "PNG" 

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

PhotoWEBP.rar

[Moosak]

استخدم هذا الكود للحصول على امتداد الصورة الأصلية .. ثم انقله للمسار الجديد ... 🙂 

Function GetFileExt(strPath As String) As String
' دالة للحصول على إمتداد الملفات مع النقطة
  Dim strFile As String
  
  strFile = Right(strPath, Len(strPath) - InStrRev(strPath, "\"))
  GetFileExt = Right(strFile, Len(strFile) - InStrRev(strFile, ".") + 1)
End Function

 

[Foksh]

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

أريد نقل صورة من مكان الى مكان المشكلة فى امتداد الصورة فى هذا السطر

اخي حدد معطيات لسؤالك بشكل أوسع ، من مكان 1 الى مكان 2 حددهم بالنسبة لمرفقك .

كيف تختار الصورة المراد نقلها مثلاً في المرفق ؟

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

أستاذ @Foksh

 

    If Dir(CurrentProject.Path & "\download\" & [id] & ".*", vbDirectory) <> "" Then
        
        
        
        If Dir(CurrentProject.Path & "\12 3\" & Left([Worker], 1) & "-file\", vbDirectory) <> "" Then
        Else
            MkDir CurrentProject.Path & "\12 3\" & Left([Worker], 1) & "-file\"
        End If
        
        Dim oldpathANDname As String, newpathANDname As String
        
        oldpathANDname = CurrentProject.Path & "\download\" & [id] & ".jpg"
        newpathANDname = CurrentProject.Path & "\12 3\" & Left([Worker], 1) & "-file\" & Me.id & ".jpg"
        
        Name oldpathANDname As newpathANDname
        Me!imgPicture.Requery
        
    End If

الصورة  سوف تنقل من مكان  oldpathANDname    الى newpathANDname 

البرنامج ينقل الصورة  ".jpg" فقط ومثل ما قال استاذ @Moosak  يجب أن أعرف امتداد الصورة ووضعه فى نهاية  السطر 

 

oldpathANDname = CurrentProject.Path & "\download\" & [id] & ".jpg"

حتى يستطيع البرنامج نقل الصورة 

[ابو جودي]

استخدم الكود كالاتى 

If Dir(CurrentProject.Path & "\download\" & [id] & ".*", vbDirectory) <> "" Then
        
        
        
        If Dir(CurrentProject.Path & "\12 3\" & Left([Worker], 1) & "-file\", vbDirectory) <> "" Then
        Else
            MkDir CurrentProject.Path & "\12 3\" & Left([Worker], 1) & "-file\"
        End If
        
        Dim oldpathANDname As String, newpathANDname As String
        
        'oldpathANDname = CurrentProject.Path & "\download\" & [id] & ".jpg"
        'newpathANDname = CurrentProject.Path & "\12 3\" & Left([Worker], 1) & "-file\" & Me.id & ".jpg"
        
		oldpathANDname = CurrentProject.Path & "\download\" & [id] & ".jpg"
		newpathANDname = CurrentProject.Path & "\12 3\" & Left([Worker], 1) & "-file\" & Me.id & GetFileExt(oldpathANDname)

        Name oldpathANDname As newpathANDname
        Me!imgPicture.Requery
        
    End If

 

[Foksh]

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

يجب أن أعرف امتداد الصورة ووضعه فى نهاية  السطر

• قم بإضافة الحقل PicFile في نموذجك
• انشئ مربع نص غير منضم وسميه مثلاُ Ext ، واجعل مصدره هذا الكود

=Right([PicFile],4)

• في الكود الخاص بك هنا

• oldpathANDname = CurrentProject.Path & "\download\" & [id] & Me.Ext

  فقط قم باستبدال "Jpg."  إلى  Me.Ext  الموجودة في كل الكود

تم تعديل أكتوبر 14, 2023 بواسطه Foksh

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

أستاذى @ابو جودي 
لم يحدث شيء

المشكلة فى امتداد السطر الاول و ليس الثانى 

 

		oldpathANDname = CurrentProject.Path & "\download\" & [id] & ".jpg"
		newpathANDname = CurrentProject.Path & "\12 3\" & Left([Worker], 1) & "-file\" & Me.id & GetFileExt(oldpathANDname)

 

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

أستاذ @Foksh  

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

[ابو جودي]

26 دقائق مضت, ابو جودي said:

		oldpathANDname = CurrentProject.Path & "\download\" & [id] & ".jpg"

طيب منا عارف انا سيبتك تجرب علشان تحاول تقدر تعرف المشكلة من فين 

المشكلة طبعا ان حضرتك ثبت الامتداد على المسار

oldpathANDname = CurrentProject.Path & "\download\" & [id] & ".jpg"

طبعا كده لن يتغير لانه دايما سوف يكون jpg

وعلى قاعدة انسف حمامك القديم 

دعنا نبدأ من البداية 

انت تريد زر امر يحدد لك صورة الموظف ثم ينقلها الى المجلد الذى تريده صح واللا غلط ؟َ

[Foksh]

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

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

جرب هذا الملف ، ممكن يفيدك بما إنه المعطيات كانت مكتملة أخي الكريم ،

 

 

Test.accdb

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

هل هناك طريقة ما 
لنبديل بين الثلاث امتدادات 
"JPEG" و "PNG" و ".jpg"

تم تعديل أكتوبر 14, 2023 بواسطه محمد احمد لطفى

[ابو جودي]

15 دقائق مضت, Foksh said:

جرب هذا الملف ، ممكن يفيدك بما إنه المعطيات كانت مكتملة أخي الكريم ،

 

 

Test.accdb 768 kB · 1 download

اى شخص لم يقم بإعداد برنامج  Adobe Acrobat Reader   على حاسبه سوف يواجه مشكلة بفقد المكتبة التى تخصه ولن تهمل مهخ القاعدة  

زى كده 

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

هل هناك طريقة ما 
لنبديل بين الثلاث امتدادات 
"JPEG" و "PNG" و ".jpg"

ممكن تقول يعنى ايه التبديل بين الثلاث امتدادت

ياريت توضيح اكثر

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

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

FileName6([CurrentProject].[Path] & "\Download\";[ID])
Kno1: Right([PicFile];Len([PicFile])-InStrRev([PicFile];"."))

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

PhotoWEBP.rar

[ابو جودي]

على النموذج وفى مربه نص ضع السطر الاتى 

=FileName([id],[worker])

وبالنسبة للكود السابق يكون كالاتى 

If Dir(CurrentProject.Path & "\download\" & [id] & ".*", vbDirectory) <> "" Then
        
        
        
        If Dir(CurrentProject.Path & "\12 3\" & Left([Worker], 1) & "-file\", vbDirectory) <> "" Then
        Else
            MkDir CurrentProject.Path & "\12 3\" & Left([Worker], 1) & "-file\"
        End If
        
        Dim oldpathANDname As String, newpathANDname As String
        
        'oldpathANDname = CurrentProject.Path & "\download\" & [id] & ".jpg"
        'newpathANDname = CurrentProject.Path & "\12 3\" & Left([Worker], 1) & "-file\" & Me.id & ".jpg"
        
		oldpathANDname = FileName([id],[worker])
		newpathANDname = CurrentProject.Path & "\12 3\" & Left([Worker], 1) & "-file\" & Me.id & GetFileExt(oldpathANDname)

        Name oldpathANDname As newpathANDname
        Me!imgPicture.Requery
        
    End If

 

[Foksh]

22 دقائق مضت, ابو جودي said:

كده

هههههههههههه ، نسيت ازالتها ، ومع ذلك فكان هدفي انه الأخ السائل لعله يخرج بفكرة من الملف 😉

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

تم عمل الكود بهذه الطريقة 

 

    If Dir(CurrentProject.Path & "\download\" & [id] & ".*", vbDirectory) <> "" Then
        If Dir(CurrentProject.Path & "\12 3\" & Left([Worker], 1) & "-file\", vbDirectory) <> "" Then
        Else
            MkDir CurrentProject.Path & "\12 3\" & Left([Worker], 1) & "-file\"
        End If
        
        Dim oldpathANDname As String, newpathANDname As String
        

        oldpathANDname = CurrentProject.Path & "\download\" & [id] & "." & Right([ext], Len([ext]) - InStrRev([ext], "."))
        newpathANDname = CurrentProject.Path & "\12 3\" & Left([Worker], 1) & "-file\" & Me.id & ".jpg"
        
        Name oldpathANDname As newpathANDname
        Me!imgPicture.Requery
        
    End If
End Sub

مع وضع 
 

FileName6([CurrentProject].[Path] & "\Download\";[ID])

فى مربع نص غير منظم 

فهل يمكن تشغيله فى الكود بدون وضعه فى النموذج

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

PhotoWEBP.rar

تم تعديل أكتوبر 14, 2023 بواسطه محمد احمد لطفى

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

تم حل المشكلة جزاكم الله خيراُ 

 

    If Dir(CurrentProject.Path & "\12 3\" & Left([Worker], 1) & "-file\" & [id] & ".*") <> "" Then
        
        Kill (CurrentProject.Path & "\12 3\" & Left([Worker], 1) & "-file\" & [id] & ".*")
        Me!imgPicture.Requery
    End If

    If Dir(CurrentProject.Path & "\download\" & [id] & ".*", vbDirectory) <> "" Then
        If Dir(CurrentProject.Path & "\12 3\" & Left([Worker], 1) & "-file\", vbDirectory) <> "" Then
        Else
            MkDir CurrentProject.Path & "\12 3\" & Left([Worker], 1) & "-file\"
        End If
        
        Dim Mypath As String
        Mypath = FileName6(CurrentProject.Path & "\Download\", Me.id)
        Dim oldpathANDname As String, newpathANDname As String
        

        oldpathANDname = CurrentProject.Path & "\download\" & [id] & "." & Right([mypath], Len([mypath]) - InStrRev([mypath], "."))
        newpathANDname = CurrentProject.Path & "\12 3\" & Left([Worker], 1) & "-file\" & Me.id & ".jpg"
        
        Name oldpathANDname As newpathANDname
        Me!imgPicture.Requery
        
    End If

 

تم تعديل أكتوبر 15, 2023 بواسطه محمد احمد لطفى