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

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


ابو جودي

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

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

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

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

على بركة الله 

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

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

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

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

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

ToolTip.gif.ff6ac9bf95a41f3a28f3f758eef73cd8.gif

ToolTip.mdb

 

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

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

1166961062_Transparent.gif.e9903406a5192c3985b7bf874e40ff73.gif

 

Transparent Forms.mdb

 

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

فكرة عمل فرز متقدم - 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

 

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

احيانا نغير خصائص النموذج 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

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

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

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

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

'--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

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

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

 

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

موديول: كود إضافة قيمة غير موجودة بالقائمة لمربع سرد (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 said:

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

 

هات مرفق 

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

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

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

فى نموذج

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

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

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

 

احبكم فى الله :fff:

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

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

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

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

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

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

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

اتغضل 

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

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

 

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

 

DATA1041-5 (6).mdb

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

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