كيفية حل كود خطا 13 type mismatch

User user · أكتوبر 7, 2021

عند الضغط على اختيار صورة يظهر خطا Type mismatch 13
مرفق الكود المستخدم 
Dim Fol As Object, DoneFiles As String
Dist = CurrentProject.Path & "/" & "Im" & "/" & [Ir] & ".jpg"
DoneFiles = "ÇáÕæÑÉ ÇáãÎÊÇÑÉ :"
Set Fol = Application.FileDialog(3)
Fol.AllowMultiSelect = False
If Fol.show Then
For I = 1 To Fol.SelectedItems.Count
sFile = ImageName(Fol.SelectedItems(I), sPath)
'If Dir(Dist & sFile) & "" = "" Then
FileCopy sPath & sFile, Dist & sFile
DoneFiles = DoneFiles & vbCrLf & I & "-" & sFile
Me.Hphoto.Value = Dist & sFile
'Else
'MsgBox "Êã ÑÝÖ ÇáÚãáíÉ " & vbCrLf & sFile & vbCrLf & "Êã ÇÎÊíÇÑ åÐå ÇáÕæÑÉ ãÓÈÞÇ "
If I > 1 Then MsgBox DoneFiles
Exit Sub
'End If
Next
End If
Exit Sub

تم تعديل أكتوبر 7, 2021 بواسطه User user

**kanory** · أكتوبر 7, 2021

جرب تغير هذا الكود <<<<<<>>>>>>>>>

Fol.AllowMultiSelect = False

بهذا ...........

Fol.AllowMultiSelect = True

User user · أكتوبر 7, 2021

2 ساعات مضت, kanory said:
جرب تغير هذا الكود <<<<<<>>>>>>>>>
Fol.AllowMultiSelect = False
بهذا ...........
Fol.AllowMultiSelect = True

للاسف نفس المشكلة اخى الكريم

**kanory** · أكتوبر 8, 2021

12 ساعات مضت, User user said:

للاسف نفس المشكلة اخى الكريم

ممكن مثال صغير للفكرة التي تريدها

User user · أكتوبر 8, 2021

13 دقائق مضت, kanory said:

ممكن مثال صغير للفكرة التي تريدها

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

**سامي الحداد** · أكتوبر 8, 2021

اليك هذا الكود ... يعمل لك فولدر ان لم يكن موجود في مسار القاعدة وايضا باسم الموظف او اي شي انت تحدده.

الكود للامانة لاحد الاساتذة مع بعض التعديلات البسيطة ... للاسف لا اعرف من هو جزاه الله كل الخير.

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

On Error GoTo err:
Dim Fs, Cf, strFolder
Const msoFileDialogFilePicker As Long = 3
Dim objDialog As Object
Set objDialog = Application.FileDialog(msoFileDialogFilePicker)
strFolder = CurrentProject.Path & "\" & "Image"
Set Fs = CreateObject("Scripting.FileSystemObject")
If Fs.FolderExists(strFolder) = False Then
Set Cf = Fs.CreateFolder(strFolder)
If Fs.FolderExists(strFolder) = True Then
MsgBox "'" & strFolder, vbInformation, "' تم انشاء المجلد في المسار التالي "
Else
MsgBox "'" & strFolder, vbExclamation, "'لم يتم انشاء المجلد"
End If
End If

If IsNull([Names]) Or [Names] = Null Or [Names] = "" Then 
[Names].SetFocus
MsgBox "من فضلك يجب كتابة الاسم أولا حتى تتمكن من إضافة صورة", vbInformation, "يجب كتابة الاسم"
Exit Sub
End If

  
Dim fso As Object
Set fso = CreateObject("scripting.filesystemobject")
    Dim varFile As Variant
    Dim destpath As Variant
    Me.Image = ""

   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

With fDialog

      .AllowMultiSelect = False

      .Title = "رجاءً قم بتحديد مكان الصورة"

      .Filters.Clear
      .Filters.Add "png image", "*.png"
      .Filters.Add "jpg image", "*.jpg"
      .Filters.Add "jpeg image", "*.jpeg"
      .Filters.Add "All Files", "*.*"

      If .show = True Then

         For Each varFile In .SelectedItems
         
       
         destpath = Application.CurrentProject.Path & "\" & "Image" & "\" & Me.Names & "f." & Right$(varFile, Len(varFile) - InStrRev(varFile, "."))
         FileCopy varFile, destpath
         Me.Image = destpath
         Me.Refresh
            
Next

Else
         MsgBox "You clicked Cancel in the file dialog box."
End If
End With
Exit Sub
err:
         MsgBox err.Description & " " & err.Number

وافنا بالنتيجة.

بالتوفيق

User user · أكتوبر 8, 2021

منذ ساعه, سامي الحداد said:

اليك هذا الكود ... يعمل لك فولدر ان لم يكن موجود في مسار القاعدة وايضا باسم الموظف او اي شي انت تحدده.

الكود للامانة لاحد الاساتذة مع بعض التعديلات البسيطة ... للاسف لا اعرف من هو جزاه الله كل الخير.

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

On Error GoTo err:
Dim Fs, Cf, strFolder
Const msoFileDialogFilePicker As Long = 3
Dim objDialog As Object
Set objDialog = Application.FileDialog(msoFileDialogFilePicker)
strFolder = CurrentProject.Path & "\" & "Image"
Set Fs = CreateObject("Scripting.FileSystemObject")
If Fs.FolderExists(strFolder) = False Then
Set Cf = Fs.CreateFolder(strFolder)
If Fs.FolderExists(strFolder) = True Then
MsgBox "'" & strFolder, vbInformation, "' تم انشاء المجلد في المسار التالي "
Else
MsgBox "'" & strFolder, vbExclamation, "'لم يتم انشاء المجلد"
End If
End If

If IsNull([Names]) Or [Names] = Null Or [Names] = "" Then 
[Names].SetFocus
MsgBox "من فضلك يجب كتابة الاسم أولا حتى تتمكن من إضافة صورة", vbInformation, "يجب كتابة الاسم"
Exit Sub
End If

  
Dim fso As Object
Set fso = CreateObject("scripting.filesystemobject")
    Dim varFile As Variant
    Dim destpath As Variant
    Me.Image = ""

   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

With fDialog

      .AllowMultiSelect = False

      .Title = "رجاءً قم بتحديد مكان الصورة"

      .Filters.Clear
      .Filters.Add "png image", "*.png"
      .Filters.Add "jpg image", "*.jpg"
      .Filters.Add "jpeg image", "*.jpeg"
      .Filters.Add "All Files", "*.*"

      If .show = True Then

         For Each varFile In .SelectedItems
         
       
         destpath = Application.CurrentProject.Path & "\" & "Image" & "\" & Me.Names & "f." & Right$(varFile, Len(varFile) - InStrRev(varFile, "."))
         FileCopy varFile, destpath
         Me.Image = destpath
         Me.Refresh
            
Next

Else
         MsgBox "You clicked Cancel in the file dialog box."
End If
End With
Exit Sub
err:
         MsgBox err.Description & " " & err.Number

وافنا بالنتيجة.

بالتوفيق

مفيش كود مختصر مثل الخاص بنا فوق

**سامي الحداد** · أكتوبر 8, 2021

اخي الكريم

ارفق مثالك حتى نستطيع تشخيص الخطاء. الظاهر هناك نقص في الكود

تحياتي

User user · أكتوبر 10, 2021

1642289677_.JPG.5961ef7c50d1dd77d394e18147d39cb0.JPG دى رسالة الخطا
والكود المستخدم

تم تعديل أكتوبر 10, 2021 بواسطه User user

**د.كاف يار** · أكتوبر 11, 2021

تفضل هذا التعديل

الصق هذا الكود في اي مكان داخل محرر الأكواد

سيتم انشاء مجلد بإسم Im في حال عدم وجوده و سيتم حفظ نسخة من الصورة

Public Function SaveImag(ImagtPath As String, FileNewName As String)
On Error GoTo ErrH
Dim fso As Object, Syso As Object, fldrname As String, fldrpath As String, MyFile As String, DstFile As String
fldrname = "Im"
Set fso = CreateObject("scripting.filesystemobject")
    fldrpath = CurrentProject.Path & "\" & fldrname
    If Not fso.FolderExists(fldrpath) Then
       fso.createfolder (fldrpath)
    End If
    MyFile = ImagtPath
    DstFile = CurrentProject.Path & "/" & fldrname & "/" & FileNewName & ".jpg"
    DBEngine.Idle
    Set Syso = CreateObject("Scripting.FileSystemObject")
    Syso.copyfile MyFile, DstFile
    Set Syso = Nothing
    SaveImag = DstFile
    MsgBox "تم اضافة الصورة بنجاح", vbInformation + vbMsgBoxRight, "تأكيد"
Exit Function
ErrH:
MsgBox "رقم الخطأ" & " : " & Err.Number & vbNewLine & "وصف الخطأ" & " : " & vbNewLine & Err.Description, vbExclamation + vbMsgBoxRight, "تنبيه"
End Function

من المفترض انه يوجد لديك العناصر التالية

- مربع نص اسم الصورة

- مربع نص مسار الصورة

- ازرار اختيار الملف

- ازرار تنفيذ الإجراء او حفظ الصورة

في ازار اختيار الصورة استخدم الكود التالي

Dim Addfile As Object
Set Addfile = Application.FileDialog(3)
With Addfile
  .AllowMultiSelect = False
  .InitialFileName = ""
  .title = "اختيار صورة"
  .Filters.Clear
  .Filters.Add "All Files", "*.jpg,*.png"
  If .Show = True Then
      ImagePathText = Trim(.SelectedItems(1)) ' مربع النص الذي سيتم تخزين مسار الصورة به
      Else
      Exit Sub
  End If
End With

و في ازرار الحفظ ضع الكود التالي

call SaveImag(ImagePathText, FileName)

ImagePathText   تعني مربع نص مسار الصورة
FileName   تعني اسم الصورة

مرفق مثال تطبيق لذلك

image.png.8e96b5f0e7da9526d3b08b485d51028e.png

MyData16.accdb

User user · أكتوبر 11, 2021

10 ساعات مضت, د.كاف يار said:
تفضل هذا التعديل

الصق هذا الكود في اي مكان داخل محرر الأكواد

سيتم انشاء مجلد بإسم Im في حال عدم وجوده و سيتم حفظ نسخة من الصورة
Public Function SaveImag(ImagtPath As String, FileNewName As String)
On Error GoTo ErrH
Dim fso As Object, Syso As Object, fldrname As String, fldrpath As String, MyFile As String, DstFile As String
fldrname = "Im"
Set fso = CreateObject("scripting.filesystemobject")
    fldrpath = CurrentProject.Path & "\" & fldrname
    If Not fso.FolderExists(fldrpath) Then
       fso.createfolder (fldrpath)
    End If
    MyFile = ImagtPath
    DstFile = CurrentProject.Path & "/" & fldrname & "/" & FileNewName & ".jpg"
    DBEngine.Idle
    Set Syso = CreateObject("Scripting.FileSystemObject")
    Syso.copyfile MyFile, DstFile
    Set Syso = Nothing
    SaveImag = DstFile
    MsgBox "تم اضافة الصورة بنجاح", vbInformation + vbMsgBoxRight, "تأكيد"
Exit Function
ErrH:
MsgBox "رقم الخطأ" & " : " & Err.Number & vbNewLine & "وصف الخطأ" & " : " & vbNewLine & Err.Description, vbExclamation + vbMsgBoxRight, "تنبيه"
End Function
من المفترض انه يوجد لديك العناصر التالية

- مربع نص اسم الصورة

- مربع نص مسار الصورة

- ازرار اختيار الملف

- ازرار تنفيذ الإجراء او حفظ الصورة

في ازار اختيار الصورة استخدم الكود التالي
Dim Addfile As Object
Set Addfile = Application.FileDialog(3)
With Addfile
  .AllowMultiSelect = False
  .InitialFileName = ""
  .title = "اختيار صورة"
  .Filters.Clear
  .Filters.Add "All Files", "*.jpg,*.png"
  If .Show = True Then
      ImagePathText = Trim(.SelectedItems(1)) ' مربع النص الذي سيتم تخزين مسار الصورة به
      Else
      Exit Sub
  End If
End With
و في ازرار الحفظ ضع الكود التالي
call SaveImag(ImagePathText, FileName)

ImagePathText   تعني مربع نص مسار الصورة
FileName   تعني اسم الصورة
مرفق مثال تطبيق لذلك

MyData16.accdb 836 kB · 1 download

من فضلك لو محتاج اضيف اكثر من صورة للعميل هيكون صيغه الكود ازاى
هيكون فيه لدى 4 مسارات لحقل Image

تم تعديل أكتوبر 11, 2021 بواسطه User user

**د.كاف يار** · أكتوبر 11, 2021

تفضل التعديل

Database2.accdb

تسجيل الدخول

كيفية حل كود خطا 13 type mismatch

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

User user

kanory

User user

kanory

User user

سامي الحداد

User user

سامي الحداد

User user

د.كاف يار

User user

د.كاف يار

Join the conversation

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

تصفح الموقع

تصفح جديد الموقع

Support

Important Information