تعديل موديول ليعمل على اوفيس 2019

[اشرف السيد يوسف]

تعديل موديول ليعمل على اوفيس 2019  وكان يعمل على الاصدارات السابقة من الاوفيس ولكم الشكر

TEST.accdb

[ابو جودي]

3 ساعات مضت, اشرف السيد يوسف said:

تعديل موديول ليعمل على اوفيس 2019  وكان يعمل على الاصدارات السابقة من الاوفيس ولكم الشكر

استبدل كود الموديول بالكود التالى 

Public Function Horizontal(tabelle As String, Feld1 As String, Feld2 As String, valFeld1 As Variant) As String
    Dim DB As DAO.Database
    Dim rs As DAO.Recordset
    Dim fieldType As Integer
    Dim sqlWhere As String
    Dim first As Boolean
    
    ' تعيين قاعدة البيانات الحالية
    Set DB = CurrentDb
    
    ' استرجاع نوع الحقل Feld1
    fieldType = DB.TableDefs(tabelle).Fields(Feld1).Type
    
    ' تنسيق القيمة بناءً على نوع الحقل
    Select Case fieldType
        Case dbText, dbMemo, dbChar
            ' النصوص: وضع القيمة بين علامات اقتباس مفردة مع معالجة علامات الاقتباس الداخلية
            sqlWhere = "[" & Feld1 & "]='" & Replace(valFeld1, "'", "''") & "'"
        Case dbDate, dbTime, dbTimeStamp
            ' التواريخ: وضع القيمة بين علامات # مع تنسيق التاريخ
            sqlWhere = "[" & Feld1 & "]=#" & Format(valFeld1, "yyyy-mm-dd hh:nn:ss") & "#"
        Case dbInteger, dbLong, dbSingle, dbDouble, dbCurrency, dbDecimal
            ' الأرقام: إدراج القيمة مباشرة
            sqlWhere = "[" & Feld1 & "]=" & valFeld1
        Case Else
            ' معالجة الأنواع غير المدعومة
            MsgBox "نوع البيانات غير مدعوم للحقل: " & Feld1, vbExclamation
            Exit Function
    End Select
    
    ' إنشاء وتنفيذ استعلام SQL
    Set rs = DB.OpenRecordset("SELECT DISTINCT [" & Feld2 & "] FROM [" & tabelle & "] WHERE " & sqlWhere & " ORDER BY [" & Feld2 & "] DESC")
    
    ' تهيئة متغير للسجل الأول
    first = True
    
    ' معالجة السجلات المسترجعة
    Do While Not rs.EOF
        If first Then
            Horizontal = rs(Feld2)  ' القيمة الأولى
            first = False
        Else
            Horizontal = Horizontal & vbCrLf & rs(Feld2)  ' إضافة القيم التالية مع فاصل سطر
        End If
        rs.MoveNext
    Loop
    
    ' تحرير الموارد
    rs.Close
    Set rs = Nothing
    Set DB = Nothing
End Function

 

[Foksh]

3 ساعات مضت, اشرف السيد يوسف said:

تعديل موديول ليعمل على اوفيس 2019  وكان يعمل على الاصدارات السابقة من الاوفيس ولكم الشكر

TEST.accdb 860 kB · 9 downloads

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

  Dim DB As Database, rs As Recordset

بأن يتم التعديل كالتالي :-

  Dim DB As DAO.Database, rs As DAO.Recordset

 

هذا من وجهة نظري المتواضعة فقط لا غير 😁 .

وكل عام وأنتم بخير جميعاً

[ابو جودي]

انت صح

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

نص او رقم او تاريخ

[Foksh]

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

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

نص او رقم او تاريخ

💯/💯

وطبعاً إضافتك جعلت الفكرة شاملة لجميع أنواع البيانات  

[اشرف السيد يوسف]

الف الف الف شكر لسيادتكم ... تم الحل فعلا .. زادكم الله علماً 

حضراتكم لا تعرفوا حجم المساعدة التى قدمتوها لى 

كل عام وحضراتكم بالف خير

الف شكر لإدارة المنتدى الكريم والسادة الأعضاء على تعبهم ومجهودهم فى مساعدتى

[اشرف السيد يوسف]

الأخوة الأعزاء .. أرجو استكمال جميلكم وحل هذة الملاحظة

فبعد حل مشكلة الموديول بنجاح -- اجد التقرير يخرج مختلف عن ترتيب بيانات الجدول ... حيث أجد اختلاف فى ترتيب المحافظات وكذلك اختلاف التواريخ عن الجدول .. أرجو حل هذة المشكلة ..

و لكم الشكر مقدماً 

مرسل نموذج للعمل عليه

TEST22.accdb

تم تعديل منذ 7 ساعات بواسطه اشرف السيد يوسف

[Foksh]

  

54 دقائق مضت, اشرف السيد يوسف said:

فبعد حل مشكلة الموديول بنجاح

اقترح عليك فتح موضوع جديد في المشكلة التي تواجهك ، وأن لا تبخل علينا في الشرح والتوضيح المفرط حتى لا ندخل في متاهات المطلوب الغير مفهوم ..

وان شاء الله تجد ما يسرك من الإخوة والأساتذة 

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