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

[ابو جودي]

السلام عليكم ورحمة الله تعالى وبركاته

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

لانى الان اتعب جدا جدا جدا جدا فى البحث داخل المنتدى للوصول الى اى معلومة او فكرة قديمة سوف احاول جاهدا جمع أفكارى بصفة مستمرة ليسهل لى او لاحبائى الرجوع اليها مستقبلا
..................

على بركة الله 

[محمد سلامة]

الله ينور يابا جودي🌹

[الحلبي]

بشمهندس / محمد عصام   مروض اكسس

لا يأتى من الحلو الا كل جميل

فى انتظار افكارك الجملية 

[أبو عبدالله الحلوانى]

ابا الجود لا يشخبط بل يصنف ويحقق

توكل علي الله يا استاذ فتصنيفكم سيكون مرجعا ان شاء الله

[ابو جودي]

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

ToolTip.mdb

 

تم تعديل أكتوبر 19, 2021 بواسطه ابا جودى

[ابو جودي]

شفافيــــــــــــTransparent Formsــــــــــــة النماذج

 

Transparent Forms.mdb

 

تم تعديل أكتوبر 19, 2021 بواسطه ابا جودى

[Eng.Qassim]

بارك الله فيك يا بشمهندس ..

لكن الشفافية لم تظهر عندي

 

[ابو جودي]

احتساب تاريخ نهاية الصلاحــــــــ( Expiration Report ) ـــــية

ExpirationDate.mdb

[ابو جودي]

انشاء مجلد واحد او العديد من المجلدات دفعة واحدة

CreateMultiFolders.mdb

[abouelhassan]

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

[ابو جودي]

فكرة عمل فرز متقدم - Smart Sort

1 - الكود داخل المديول  

2 - استدعاء الكود من خلال السطر التالى مع تغيير الـ *** الى اسم عنصر التحكم الذى يدل على الحقل المراد عمل الفرز له
 

SmrtSort "***"

..

'-----------------------------------------------------------'
'           _  +-----------officena-----------+ _           '
'          /o) |             |||||            | (o\         '
'         / /  |           @(~O^O~)@          |  \ \        '
'        ( (_  | _   ----oOo--Moh--oOo----- _ |  _) )       '
'       ((\ \) +/o)----------3ssam---------(o\+ (/ /))      '
'       (\\\ \_/ /                          \ \_/ ///)      '
'        \      /                            \      /       '
'         \____/________Mohammed Essam________\____/        '
'--28-10-2021-----------------------------------------------'
Option Compare Database
Option Explicit

Public bt As Byte

Function SmrtSort(ByVal ObjectName As String)

  DoCmd.GoToControl ObjectName
    If bt = 0 Then
      DoCmd.RunCommand acCmdSortAscending
      bt = 1
    ElseIf bt = 1 Then
      DoCmd.RunCommand acCmdSortDescending
      bt = 2
    ElseIf bt = 2 Then
      DoCmd.RunCommand acCmdRemoveAllSorts
      bt = 0
    End If
    
End Function

 

[ابو جودي]

احيانا نغير خصائص النموذج Border style لتكون  None 
فى هذه الحالة لا نستطيع تغير مكان النموذج من خلال السحب والافلات بالماوس

وحل هذه المشكلة يكمن فى الاتى  

ننشئ موديول ونضع به الكود الاتى 

Option Compare Database
Option Explicit

'API to move a form with a mouse down event

Public Const WM_NCLBUTTONDOWN = &HA1

Public Const HT_CAPTION = &H2

#If VBA7 Then
    Public Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, _
        ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    
    Public Declare PtrSafe Function ReleaseCapture Lib "user32.dll" () As Long
#Else
    Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, _
        ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    
    Public Declare Function ReleaseCapture Lib "user32.dll" () As Long
#End If


Public Function MovFrm(ByVal F As Form, ByVal X As Single)
  X = ReleaseCapture()
  X = SendMessage(F.hWnd, WM_NCLBUTTONDOWN, HT_CAPTION, 0)
End Function

ونذخب الى النموذج وفى الحدث  on Mouse Down  لــ FormHeader

نضع السطر الاتى 
 

Call MovFrm(Me, X)

 

اخيـــــــرا مرفق التطبيق 
 

API to move a form.mdb

تم تعديل نوفمبر 4, 2021 بواسطه ابا جودى

[ابو جودي]

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

نسخ احتياطى لقاعدة الجدوال تلقائيا عند فى كل مرة يتم فيعا اغلاق القاعدة الامامية 

الكود داخل المديول وتلميحات الشرح بقدر المستطاع 

'--25-10-2021-----------------------------------------------'
Option Compare Database
Option Explicit

Function RunSub()

Dim dbs                   As DAO.Database
Dim tdf                   As DAO.TableDef

Dim strPathDB             As String
Dim strNameExtensionDB    As String
Dim strNameDB             As String
Dim strExtensionDB        As String

Dim strBackupPath         As String

Dim strNewNameBackupDB    As String

Dim fso                   As Object
Dim Syso                  As Object

  Set dbs = CurrentDb()

  With dbs
    For Each tdf In .TableDefs
      'Is the table a linked table?
      If tdf.Attributes And dbAttachedODBC Or tdf.Attributes And dbAttachedTable Then
        With tdf
          'Connect property contains path of link
          strPathDB = .Properties("Connect").Value
          'Path of linked database tables
          strPathDB = Replace(strPathDB, ";DATABASE=", vbNullString)
        End With
      End If
    Next tdf
   End With
  'Backup path directory
  strBackupPath = CurrentProject.Path & "\Backup\"
  
  Set fso = CreateObject("scripting.filesystemobject")
  'Create the Backup folder if it does not exist
  If Not fso.FolderExists(strBackupPath) Then fso.createfolder (strBackupPath)
  
  'Database name with extension
  strNameExtensionDB = Right(strPathDB, Len(strPathDB) - InStrRev(strPathDB, "\"))

  'Database name without extension
  strNameDB = Left(strNameExtensionDB, InStrRev(strNameExtensionDB, ".") - 1)
  
  'extension only
  strExtensionDB = Right(strPathDB, Len(strPathDB) - InStrRev(strPathDB, "."))
  
  'New name for backup database
  strNewNameBackupDB = strNameDB & "-Backup-" & Format(Now, "mm-yyyy") & "." & strExtensionDB
  
  'Backup database save path directory
  strBackupPath = strBackupPath & strNewNameBackupDB

  DBEngine.Idle
    
    'Copy the backup database to its directory
    Set Syso = CreateObject("Scripting.FileSystemObject")
      Syso.copyfile strPathDB, strBackupPath
    Set Syso = Nothing
    
  DoCmd.RunCommand acCmdExit
End Function

 

المرفق 

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

Automatically Backup.zip

[ابو جودي]

موضوع هام جدا جدا جدا
يضم بين طياته الدرر الكثيرة  تليون نتيجة البحث من موديول بكل سهولة , الفلاتر المتعددة , المرونة فى تصميم كود داخل موديول 

 

[ابو جودي]

موديول: كود إضافة قيمة غير موجودة بالقائمة لمربع سرد (Not In List)

يتم استدعاء الكود فى الحدث  >>------> عند عدم الوجود فى القائمة  -  NotInList  من خلال الكود الاتى 
مع تغيير  tableName  باسم الجدول المراد اضاقة القيمة الجديدة اليه
وتغيير FieldName  باسم الحقل داخل الجدول المراد اضاقة القيمة الجديدة اليه

Call CmboNotInList("tableName", "FieldName", NewData, Response)

الموديول

Public Sub CmboNotInList(ByVal strTableName As String, ByVal strFieldName As String, ByVal strNewData As String, ByRef intResponse As Integer)

On Error GoTo Proc_Err
   
   Dim sSQL As String
   Dim sMsg As String

   intResponse = acDataErrContinue
   
   sMsg = """" & strNewData & """ is not in the current list. " & vbCrLf & vbCrLf & "Do you want to add it? "
   
   If MsgBox(sMsg, vbYesNo, "Add New Data") <> vbYes Then
      GoTo Proc_Exit
   End If
   
   sSQL = "INSERT INTO [" & strTableName & "] " & "([" & strFieldName & "])" & " SELECT """ & strNewData & """;"
      
   With CurrentDb
      .Execute sSQL
      If .RecordsAffected > 0 Then
         intResponse = acDataErrAdded
      End If
   End With
   
Proc_Exit:
   Exit Sub
Proc_Err:
   MsgBox Err.Description, , "ERROR " & Err.Number & "   CmboNotInList"
   Resume Proc_Exit
   Resume
End Sub

 

مرفق 

 

Not In List.mdb

[ابو جودي]

مربع اختيار غير منضم فى نموذج مستمر
 

 

[abouelhassan]

أستاذى هل من كود لعمل sort من الاصغر الى الاكبر لجدول بارك الله فيك استاذنا

 

[ابو جودي]

منذ ساعه, abouelhassan said:

أستاذى هل من كود لعمل sort من الاصغر الى الاكبر لجدول بارك الله فيك استاذنا

 

هات مرفق 

[abouelhassan]

10 دقائق مضت, ابا جودى said:

هات مرفق 

تفضل. استاذنا الكريم

 

DATA1041-5.mdb

[ابو جودي]

2 دقائق مضت, abouelhassan said:

تفضل. 

 

DATA1041-5.mdb 1.32 \u0645\u064a\u062c\u0627 \u0628\u0627\u064a\u062a · 0 downloads

لطفا اين تريد وضع كود الترتيب

فى نموذج

تم تعديل نوفمبر 5, 2021 بواسطه ابا جودى

[abouelhassan]

حبيبي استاذنا نعم فى نموذج جميع البيانات 

احترامى وتقديري

[ابو جودي]

18 دقائق مضت, abouelhassan said:

حبيبي استاذنا نعم فى نموذج جميع البيانات 

 

احبكم فى الله 

لطفا ما اسم النموذج كما سميته حضرتك فى المرفق الله يرضى عليك

وحاول الله يرضى عليك بعد ذلك وضه مرفق لا يحتوى على تطبيق كامل

فقط مرفق بسيط يتم الاجابة عليه بسهوله 

[abouelhassan]

بارك الله فيك اخى الكريم اسمه frm_Items

مشكور احترامى

[ابو جودي]

16 دقائق مضت, abouelhassan said:

بارك الله فيك اخى الكريم اسمه frm_Items

مشكور احترامى

اتغضل 

فى المرفق الطريقتين التقليدية من خلال زر امر لكل ترتيب نريد عمله 

والطريقة الذكية كما اسميتها من خلال نقرتين على العنوان لكل حقل من خلال موديول

 

والشرح هنا يا افندم 

 

DATA1041-5 (6).mdb

تم تعديل نوفمبر 5, 2021 بواسطه ابا جودى

[abouelhassan]

تسلم يمينك استاذى تحف والله روعة روعة

بارك الله فيك اخى الكريم