اذهب الي المحتوي
أوفيسنا

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


ابو جودي

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

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


Export Multi Reports.mdb

  • Like 1
  • Thanks 1
رابط هذا التعليق
شارك

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

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


 

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

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

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

 

رابط هذا التعليق
شارك

  • 2 months later...

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

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

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

 

تم تعديل بواسطه ابو جودي
  • Like 2
رابط هذا التعليق
شارك

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

  • Confused 1
رابط هذا التعليق
شارك

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

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

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

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

 

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

تم تعديل بواسطه ابو جودي
  • Like 1
رابط هذا التعليق
شارك

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

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

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

 

  • Like 2
رابط هذا التعليق
شارك

  • 5 months later...
في 19‏/10‏/2021 at 20:58, ابو جودي said:

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

لك جزيل الشكر

تم تعديل بواسطه mrbakr
  • Thanks 1
رابط هذا التعليق
شارك

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

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

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

 

  • Like 1
رابط هذا التعليق
شارك

  • 1 year later...

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

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

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • اضف...

Important Information