مساعدة في حل خطاء في ال VBA

[omarAbdalrazaq]

السلام عليكم اخواني الاعزاء 

ارجو مساعدتي في التعرف على سبب المشكلة في VBA

وقد قمت برفع صورة للاخطاء

مع الشكر والتقدير

[jjafferr]

وعليكم السلام 🙂

 

1. ماهي رسالة الخطأ ؟

2. رجاء لا تضع الصورة للشاشة كاملة ، فلا نستطيع قراءة الكود (جرب انت بنفسك وحاول تشوف الصورة المرفقة اعلاه 🙂 ) ،

وإنما اقطع الصورة ، وضع الجزء المهم منها 🙂

 

او طبعا تقدر تضع نسخة من الكود.

 

جعفر

[omarAbdalrazaq]

اسف على الصورة

وهذه نسخة من الكود

والمشكلة في دالة isnothing يعطيني ال VBA رسالة الخطاء  sub or function not defined

Option Compare Database
Dim ImageFilename, ImageFolder, AltFolder As String
'للتعامل مع السحب والافلات للصور
Private Sub DBPixM_ImageModified()
On Error Resume Next
DoCmd.RunCommand acCmdSaveRecord
Dim s As String
If DBPixM.ImageBytes < 1 Then
    DocPic = Null
Else
    'تسمية الصورة
    s = WheelID & "_" & DocType & "_" & DocNumber & "-" & Format(DocDate, "dd-mm-yyyy") & "_" & DocID
    s = Replace(s, "/", "_")
    If DBPixM.ImageFormat = 1 Then 'jpeg
        s = s & ".jpg"
    Else
        s = s & ".png"
    End If
    If isnothing(ImageFolder) Then
        ImageFolder = CurrentFolder
        ImageFilename = ImageFolder & s
    'للتاكد من عدم تعارض اسماء الملفات
    If fileexist(ImageFilename) Then
        If MsgBox("لديك ملف بنفس الاسم وبنفس الموضع" & vbNewLine & "هل تريد استبدال الوثيقة؟", vbQuestion + vbYesNo + vbMsgBoxRight, "سئوال") = vbNo Then DBPixM.ImageViewFile ImageFilename: Exit Sub
    End If
    If DBPixM.ImageSaveFile(ImageFilename) Then
        If isrelative(ImageFilename) Then
            DocPic = Right(ImageFilename, Len(ImageFilename) - Len(CurrentProject.path) - 1)
        ElseIf isnetpath(ImageFilename) Then
            DocPic = Right(ImageFilename, Len(ImageFilename) - Len(CurrentFolder) + netpathlen(CurrentFolder))
        Else
            DocPic = ImageFilename
            ImageFolder = Left(ImageFilename, InStrRev(ImageFilename, "\"))
        End If
        DoCmd.RunCommand acCmdSaveRecord
    Else
        UsMes.Caption = vbnnewline & "تعذر حفظ صورة الوثيقة"
        DBPixM.ImageViewBlob (Null)
        UsMes.Visible = True
        DBPixM.Visible = False
    End If
        
End If

End Sub

Private Sub Form_Current()
On Error Resume Next

Dim Tr As Boolean

UsMes.Visible = False: DBPixM.Visible = True
If Not isnothing(DocPic) Then
    If istrimed(DocPic) Then
        If IsNoPath(DocPic) Then
            ImageFilename = CurrentFolder & "\" & DocPic
        ElseIf isnetpath(CurrentFolder) Then
            If InStr(CurrentFolder, Left(DocPic, InStr(DocPic, "\"))) > 0 Then
                ImageFilename = CurrentFolder & Mid(DocPic, 1 + InStrRev(DocPic, "\"))
            Else
                ImageFilename = CurrentFolder & IIf(Left(DocPic, 1) = "\", "", "\") & DocPic
            End If
        Else
            ImageFilename = CurrentProject.path & IIf(Left(DocPic, 1) = "\", "", "\") & DocPic
            CurrentFolder = CurrentProject.path & "\"
            Tr = True
        End If
    Else
        ImageFilename = DocPic
    End If
    If fileexist(ImageFilename) Then
        DBPixM.ImageViewFile ImageFilename
    Else
        If Tr Then ImageFilename = ImageFolder & DocPic
        If fileexist(ImageFilename) Then
            DBPixM.ImageViewFile ImageFilename
            CurrentFolder = ImageFolder
        Else
            UsMes.Caption = vbNewLine & "صورة الوثيقة مفقودة"
            UsMes.Visible = True
            DBPixM.ImageViewBlob (Null)
            CurrentFolder.SetFocus
            DBPixM.Visible = False
        End If
    End If
    ImageFolder = IIf(isnothing(AltFolder), Left(ImageFilename, InStrRev(ImageFilename, "\")), AltFolder)
Else
    UsMes.Caption = vbNewLine & "اضف وثيقة جديدة"
    UsMes.Visible = True
    DBPixM.ImageViewBlob (Null)
    CurrentFolder.SetFocus
    DBPixM.Visible = False
End If
End Sub

Private Sub Form_Load()
'جعل مكان الحفظ عند التشغيل هو مكان البرنامج
CurrentFolder = CurrentProject.path
End Sub

 

[jjafferr]

4 ساعات مضت, omarAbdalrazaq said:

والمشكلة في دالة isnothing يعطيني ال VBA رسالة الخطاء  sub or function not defined

رسالة الخطأ تقول بأنها لم تحصل على الدالة isnothing !!

فهل هي موجودة في الكود عندك ؟

او يمكن انك نسخت الكود هذا من برنامج آخر ، ونسيت ان تنسخ الدالة isnothing !!

 

وجدت الدالة هنا : https://www.youtube.com/watch?v=MItoTRM8-kw

 

فنسختها من الفيديو وكتبتها هنا لتسهيل الامر ، لهذا السبب فأنا لا علاقة لي مع الدالة 🙂
اعمل وحدة نمطية جديدة ، ثم احفظ هذه الدالة هناك :

Public Function IsNothing(ByVal V) As Integer
    On Error GoTo nerr
    
    IsNothing = True
    
    Select Case VarType(V)
        Case 0  'empty
            GoTo fext
            
        Case 1  'null
            GoTo fext
        
        Case 2, 3, 4, 5, 6 'int, long, single, double, currency
            If V <> 0 Then IsNothing = False
        
        Case 7  'date/time
            IsNothing = False
        
        Case 8  'string
            If (Len(V) <> 0 And V <> " ") Then IsNothing = False
        
    End Select

fext:
    On Error GoTo 0
    Exit Function
    
nerr:
    IsNothing = False
    Resume fext
    
End Function

 

جعفر

[omarAbdalrazaq]

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

[omarAbdalrazaq]

عندي مشكلة اخرى في داله اخرة وهي   If istrimed اين اجد هذه الدالة هل اجدها موجودة في صفحات الويب ام يجب علي البحث في الفديوهات اليوتيوب

تم تعديل مايو 8, 2020 بواسطه omarAbdalrazaq

[jjafferr]

همممم

رجاء الرجوع الى البرنامج الاصل الذي اخذت الكود منه ، فهذه الدوال خاصة بذلك البرنامج ، ولا نعرف عنها شيء 🙂

لأني شايف دالة IsNoPath كذلك 🙄

 

جعفر

[omarAbdalrazaq]

1 دقيقه مضت, jjafferr said:

همممم

رجاء الرجوع الى البرنامج الاصل الذي اخذت الكود منه ، فهذه الدوال خاصة بذلك البرنامج ، ولا نعرف عنها شيء 🙂

لأني شايف دالة IsNoPath كذلك 🙄

 

جعفر

استاذ جعفر اتمنى اني لم اثقل عليك ولكني لم استطيع تطبيق الفديوات بصورة صحيحة فهل لك ان تدلني على موضوع في هذا المنتدى العزيز لشرح عمل فورم ارشفة(ادخال صور+سكنر) بصورة اسهل لحاحتي الماسة الية في عملي مع الشكر الجزيل على سعة صدرك

[jjafferr]

ابحث في المنتدى ، وسترى الكثير 🙂

 

جعفر

[سامي الحداد]

في ٨‏/٥‏/٢٠٢٠ at 02:28, omarAbdalrazaq said:

السلام عليكم اخواني الاعزاء 

ارجو مساعدتي في التعرف على سبب المشكلة في VBA

وقد قمت برفع صورة للاخطاء

مع الشكر والتقدير

السلام عليكم اخواني.

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

وهذا رابط الشركة.   http://www.ammara.com

أتمنى أن يكون فيه إفادة.