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

[king5star]

تسلم ايدك كلها افكار جميلة 

[ابو جودي]

بيانات اجبارية التحقق من استكمالها قبل الحفظ

 

[ابو جودي]

تصدير ( تقرير / تقارير ) الى  PDF 
المميزات
1- مرونة فى اختيار مسار تصدير الـ ( تقرير / تقارير )
2- اختيار تقرير واحد من القائمة أو أكثر لتصديرهم الى مسار محدد
3-اختيار الاجراء بعد التصدير استعراض او عدم ملف الـ PDF
4-الاكواد فى روتين عام يمكن استدعائها من اى مكان 
5-امكانية اضافة طباعة التقارير مع او بدل كود التصدير الى PDF  وهذه ميزة كتابة الكود فى روتين عام داخل موديول 

Export Multi Reports.mdb

[abouelhassan]

احترامى لك استاذي الفاضل بارك الله فيك

[ابو جودي]

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

DCount("*", "table or qury Name", stLinkCriteria)

 

نستخدم ذلك مع الارقام'
stLinkCriteria = "[PersonalNumber]=" & Me.PersonalNumber

نستخدم ذلك مع النصوص'
stLinkCriteria = "[PersonalName] ='" & [txtLastName] & "'"

نستخدم ذلك مع التواريخ'
stLinkCriteria ="[DateOfBirth] =#" & [txtDateOfBirth] & "#"

 

[ابو جودي]

روتين عام يتم تمرير النص اليه ليقوم بعمل تعريه للنص من اى اشكال او رموز او حرف غير الاحرف العربية 

يعنى نقدر نقول مع هذا الروتين وداعا لكل حركات ورموز التشكيل

If strString & "" = "" Then Exit Function
Dim lngCtr As Long
Dim intChar As Integer
    For lngCtr = 1 To Len(strString)
        intChar = AscW(Mid(strString, lngCtr, 1))
        If intChar = 32 Or _
            intChar >= 1569 And intChar <= 1594 Or _
            intChar >= 1601 And intChar <= 1610 Or _
            intChar >= 1648 And intChar <= 1649 Then
            StripSpCharsOnly = StripSpCharsOnly & ChrW(intChar)
        End If
    Next lngCtr
    StripSpCharsOnly = Trim(StripSpCharsOnly)

 

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

Public Function StripSpChars(strString As String) As String

If strString & "" = "" Then Exit Function
Dim lngCtr As Long
Dim intChar As Integer
    For lngCtr = 1 To Len(strString)
        intChar = AscW(Mid(strString, lngCtr, 1))
        If intChar = 32 Or _
            intChar >= 1569 And intChar <= 1594 Or _
            intChar >= 1601 And intChar <= 1610 Or _
            intChar >= 1648 And intChar <= 1649 Then
            StripSpChars = StripSpChars & ChrW(intChar)
        End If
    Next lngCtr
    
    
    Dim itm As Variant
    For Each itm In Array(ChrW("1649"))
        StripSpChars = Replace(StripSpChars, CStr(itm), ChrW("1575"))
    Next
    
    For Each itm In Array(ChrW("1648") & ChrW("1604"))
        StripSpChars = Replace(StripSpChars, CStr(itm), ChrW("1575") & ChrW("1604"))
    Next
    
    For Each itm In Array(ChrW("1610") & ChrW("1648"))
        StripSpChars = Replace(StripSpChars, CStr(itm), ChrW("1610") & ChrW("1575"))
    Next
    
    For Each itm In Array(ChrW("1648"))
        StripSpChars = Replace(StripSpChars, CStr(itm), "")
    Next
    
    StripSpChars = Trim(StripSpChars)

End Function

 

تم تعديل يناير 13, 2022 بواسطه ابو جودي

[zero1111330566]

عندي سجل به بيانات في نموذج اريد عند تغيير سعر المنتج يتغير التاريخ تلقائيا لتاريخ اليوم و يكتب في خانة الملاحظات(تم تعديل السعر في اليوم) 

[ابو جودي]

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

بدعم مكتبات الجافا والـ  NET Framework 4.7

ميزات القاعدة 

1. حمل ملفاتى الهامة داخل القاعدة وبذلك لن يتم فقدانها مطلقا لاى سبب الا بفقد القاعدة نفسها
2. عند نقل القاعدة لاى جهاز يتم وضع الملفات بتحميلها من القاعدة الى الجهاز اليا فى مسار القاعدة فلن يشغل بال المستخدم اى شئ بخصوص ملفات المكتبات
3. عند عدم تسجيل المكتبات يتم ذلك اليا دون ادنى تدخل من المستخدم 
4. يتم فتح الملف الدفعى اليا فى حالة عدم تسجيل المكتبات وهو يعيد تشغيل نفسه كمسؤل ويقوم باللازم
5. عند الانتها للملف الدفعى من التسجيل للمكتبات يعيد فتح القاعدة اليا واغلاق نفسه

 

تحميل القاعدة من هنا

تم تعديل يناير 14, 2022 بواسطه ابو جودي

[abouelhassan]

شكر وتقدير واحترام من اخيك استاذنا ابو جودى

[ابو جودي]

-- الوقت والتاريخ
 

تاريخ آخر يوم فى الشهر المحدد

LastDayInMonth(01/01/2022)

Public Function LastDayInMonth(ByVal AnyDate As Date) As Date
    LastDayInMonth = DateSerial(Year(AnyDate), Month(AnyDate) + 1, 0)
End Function

----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

عدد ايام الشهر المحددد

NumofDays(01/01/2022)

Public Function NumofDays(ByVal AnyDate As Date)
    NumofDays = Day(DateSerial(Year(AnyDate), Month(AnyDate) + 1, 0))
End Function

 

[mrbakr]

في 19‏/10‏/2021 at 20:58, ابو جودي said:

التلميح داخل مربع النص مع علامة مائية فى حالة كان مربع النص فارغ ويختفيان بمجرد التركيز داخل مربه النص او الكتابة  ...

لك جزيل الشكر

تم تعديل يونيو 22, 2022 بواسطه mrbakr

[ابو جودي]

انشاء قاعدة بيانات مشفرة بكلمة مرور

 تستدعى القانك بأسمة من اى مكان وفى اى حدث على حسب هواك بالسطر التالى 

Call MkDbByPassword

وتغير فى الفانك بس على التوالى 

المسار  , اسم القاعدة الجديدة التى تريد انشاءها . كلمة المرور التى تريدها فى المتغيرات

    strDbPath                >>>---->>     المسار
    strNewDbName      >>>---->>     اسم قاعدة البيانات الجديدة ولا تنسى الامتداد
    strPassNewDb        >>>---->>      كلمة المرور التى تريد تشفير القاعدة بها

 

Public Function MkDbByPassword()
    Dim wrkDefault      As Workspace
    Dim dbsNew          As DAO.Database
    Dim strDbPath       As String
    Dim strNewDbName    As String
    Dim strPassNewDb    As String
    
    strDbPath = CurrentProject.Path & "\"
    strNewDbName = "NewDB.mdb"
    strPassNewDb = "00"
    
    Set wrkDefault = DBEngine.Workspaces(0)

    If Dir(strDbPath & strNewDbName) <> "" Then Kill strDbPath & strNewDbName
    Set dbsNew = wrkDefault.CreateDatabase(strDbPath & strNewDbName, dbLangGeneral & ";PWD=" & strPassNewDb)
End Function

 

[HUSSIN]

 

 مبدع كعادتك

على قدر أهل العزم تأتي العزائم 👍

[ابو جودي]

تغيير التسمية لازرار صندوق الرسائل و افكار التحكم فى صندوق الرسائل

full control arabic Message Box 32x,64x .mdbFull Arabic Message Box V3 32X, 64x.accdb