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

البحث في الموقع

Showing results for tags 'شخابيط وافكار'.

  • Search By Tags

    اكتب الكلمات المفتاحيه بينها علامه الفاصله
  • Search By Author

نوع المحتوي


الاقسام

  • الترحيب
  • قسم تطبيقات و لغات مايكروسوفت
    • قنوات تعليمية شخصية و دورات تدريبية مجانية و مدفوعة
    • إعلانات شخصية بأجر للاعضاء
    • المنتدى المفتوح
    • منتدى الاكسيل Excel
    • قسم الأكسيس Access
    • دعم أنظمة الويندوز المختلفة
    • منتدي الوورد Word
    • منتدى الباوربوينت
    • منتدى الاوتلوك Outlook
    • منتدى الفيزيو Visio
    • منتدي مايكروسوفت بروجكت Ms Project
    • منتدى الفرنت بيج العام Frontpage
    • تطبيقات Power Apps
    • وان نوت One Note
    • الناشر بابليشر Publisher
    • Communicator
    • Expression Web
    • SQL Server
    • VB.net
    • C#.net
    • Asp.net
  • الغات و أدوات البرمجة الأخرى
    • حوارات الويب العامة
    • Delphi
    • PHP
    • برمجة الاندرويد
  • أقسام الإدارة و إدارة المشاريع و تطبيقاتها
    • الاستراتيجية وإدارة محافظ المشاريع
    • إدارة المشاريع
    • Scaled Agile SAFe
    • إدارة الجودة
    • القيادة و تنمية المهارات
    • Primavera Enterprise
    • Primavera 3.1
  • البحث العلمي و علوم البيانات
    • مناهج البحث العلمي
    • علم الإحصاء
    • الذكاء الإصطناعي و التنقيب فى البيانات
    • Orange
    • R
    • SPSS
    • Python
  • القسم العام
    • مشاركات المدونات
    • نرحب بزوار الموقع
    • قسم الاقتراحات و الملاحظات
    • أوفيسنا على الفيسبوك

الاقسام

  • VBA Code Library
  • قسم الإكسيل
  • قسم الأكسيس
  • قسم الوورد
  • Project Management
  • Self development التطويرالذاتي
  • EFQM & DGEP
  • معلومات مفيدة
  • أدوات عامة

مدونات

  • M-Taher's Blog
  • مدونة محمد طاهر
  • Officena
  • اا الفاروق اا
  • ‎مدونة أخبار التكنولوجيا
  • M-Taher's Blog
  • يحيى حسين's Blog
  • خبور خير's Blog
  • Dr. AbdelMalek Abu Sheikh's Blog
  • m.hindawi's Blog
  • احمدزمان's Blog
  • الحسامي
  • مدونة أ / محمد صالح
  • yahiaoui's Blog
  • عبدالله المجرب's Blog
  • صيد الخواطر
  • حمادة عمر مدونة
  • مدونة جعفر
  • مدونة عادل حنقي
  • مجدى يونس: لمسة وفاء لمنتدى اوفيسنا
  • Excel Expert Financial&Accounting
  • مدونة اعمال ايقونات الماس لمنتدى اوفيسنا
  • رقائق فى دقائق
  • Shivan Rekany

ابحث عن النتائج فى ......

ابحث عن النتائج التي تحوي ....


تاريخ الانشاء

  • بدايه

    End


اخر تحديث

  • بدايه

    End


Filter by number of...

انضم

  • بدايه

    End


مجموعه


Job Title


البلد


الإهتمامات


AIM


MSN


Website URL


ICQ


Yahoo


Jabber


Skype

تم العثور علي 21 نتائج

  1. السلام عليكم ورحمة الله تعالى وبركاته عندما نتحدث عن توسيط النماذج والتقارير لابد من الأخذ فى الاعتبار ان خاصية PopUp لها تأثير كبير فإن كانت PopUp = True لها أكواد تقوم بعمل التوسيط للنماذج والتقارير داخل الشاشة خاصة ولا تقوم بعملها ان كانت PopUp = False والعكس كذلك واحيانا ننسى ذكر هذا الأمر عند عرض الاكواد والامثلة ولذلك تعمل عند البعض ولا تعمل عند اخرين بل واحيانا اثناء التصميم ننسى هذا الامر ايضا ومن أجل ذلك بعد البحث المرير وترتيب الأفكار بفضل الله تعالى تم دمج الأكواد حتى تعمل تبعا للخاصية PopUp ايما كان اعدادها حتى وان نسى المستخدم ذلك الامر أوحتى إن كان لا يدرى عنه شئ المرفق الاتى ان شاء الله به حل المشكلة تماما طيب ما الفرق بين عمل الاكواد مع خاصية PopUp ان كانت PopUp = True يتم توسيط داخل الشاشة نفسها تبعا لابعاد شاشة العرض نفسها مهما اختلف مقاس الشاشة اما ان كان PopUp = False يتم التوسيط داخل اطار تطبيق الاكس نفسه الاكواد كالاتى اولا كلاس ولابد ان يكون اسم الكلاس clsAutoCenter وان احببتم تغيير الاسم فيجب تعديله فى الاكواد التى تخص الموديول بنفس الاسم الجديد اولا الكلاس : clsAutoCenter '|---01/11/2021__________________________________________________________________________________________| '|___www.officena.net_______________________|___________________________________________________________| '| | | '| __ _ | _ +-----------officena-----------+ _ | '| \ `/ | | /o) | ||||| | (o\ | '| \__`! | / / | @(~O^O~)@ | \ \ | '| / ,' `-.__________________ | ( (_ | _ ----oOo--Moh--oOo----- _ | _) ) | '| '-'\_____ U `-. | ((\ \) +/o)----------3ssam---------(o\+ (/ /)) | '| \____()-=O=O=O=O=O=[]====--) | (\\\ \_/ / \ \_/ ///) | '| `.___ ,-----,_______...-' | \ / \ / | '| / .' | \____/________Mohammed Essam________\____/ | '| / .' | | '| / .' | 01/11/2021 | '| `-' | | '|_____www.officena.net_____________________|___________________________________________________________| '|_____Thank you for visiting https://www.officena.net__________________________________________________' Option Compare Database Option Explicit Private Type RECT 'RECT structure used for API calls. Left As Long Top As Long Right As Long Bottom As Long End Type Private Type POINTAPI 'POINTAPI structure used for API calls. X As Long Y As Long End Type Private m_hWnd As Long 'Handle of the window. Private m_rctWindow As RECT 'Rectangle describing the sides of the last polled location of the window. Private Const m_ERR_INVALIDHWND = 1 Private Const m_ERR_NOPARENTWINDOW = 2 #If VBA7 Then Private Declare PtrSafe Function apiIsWindow Lib "user32" Alias "IsWindow" (ByVal hWnd As LongPtr) As Long Private Declare PtrSafe Function apiMoveWindow Lib "user32" Alias "MoveWindow" (ByVal hWnd As LongPtr, ByVal X As Long, ByVal Y As Long, _ ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long 'Moves and resizes a window in the coordinate system of its parent window. Private Declare PtrSafe Function apiGetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hWndPtr As Long, lpRect As RECT) As Long 'After calling, the lpRect parameter contains the RECT structure describing the sides of the window in screen coordinates. Private Declare PtrSafe Function apiScreenToClient Lib "user32" Alias "ScreenToClient" (ByVal hWnd As LongPtr, lpPoint As POINTAPI) As Long 'Converts lpPoint from screen coordinates to the coordinate system of the specified client window. Private Declare PtrSafe Function apiGetParent Lib "user32" Alias "GetParent" (ByVal hWnd As LongPtr) As Long 'Returns the handle of the parent window of the specified window. #Else Private Declare Function apiIsWindow Lib "user32" Alias "IsWindow" (ByVal hWnd As Long) As Long Private Declare Function apiMoveWindow Lib "user32" Alias "MoveWindow" (ByVal hWnd As Long, ByVal X As Long, ByVal Y As Long, _ ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long 'Moves and resizes a window in the coordinate system of its parent window. Private Declare Function apiGetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hWnd As Long, lpRect As RECT) As Long 'After calling, the lpRect parameter contains the RECT structure describing the sides of the window in screen coordinates. Private Declare Function apiScreenToClient Lib "user32" Alias "ScreenToClient" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long 'Converts lpPoint from screen coordinates to the coordinate system of the specified client window. Private Declare Function apiGetParent Lib "user32" Alias "GetParent" (ByVal hWnd As Long) As Long 'Returns the handle of the parent window of the specified window. #End If Private Sub RaiseError(ByVal lngErrNumber As Long, ByVal strErrDesc As String) 'Raises a user-defined error to the calling procedure. Err.Raise vbObjectError + lngErrNumber, "clFormWindow", strErrDesc End Sub Private Sub UpdateWindowRect() 'Places the current window rectangle position (in pixels, in coordinate system of parent window) in m_rctWindow. Dim ptCorner As POINTAPI If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then apiGetWindowRect m_hWnd, m_rctWindow 'm_rctWindow now holds window coordinates in screen coordinates. If Not Me.Parent Is Nothing Then 'If there is a parent window, convert top, left of window from screen coordinates to parent window coordinates. With ptCorner .X = m_rctWindow.Left .Y = m_rctWindow.Top End With apiScreenToClient Me.Parent.hWnd, ptCorner With m_rctWindow .Left = ptCorner.X .Top = ptCorner.Y End With 'If there is a parent window, convert bottom, right of window from screen coordinates to parent window coordinates. With ptCorner .X = m_rctWindow.Right .Y = m_rctWindow.Bottom End With apiScreenToClient Me.Parent.hWnd, ptCorner With m_rctWindow .Right = ptCorner.X .Bottom = ptCorner.Y End With End If Else RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid." End If End Sub Public Property Get hWnd() As Long 'Returns the value the user has specified for the window's handle. If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then hWnd = m_hWnd Else RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid." End If End Property Public Property Let hWnd(ByVal lngNewValue As Long) 'Sets the window to use by specifying its handle. 'Only accepts valid window handles. If lngNewValue = 0 Or apiIsWindow(lngNewValue) Then m_hWnd = lngNewValue Else RaiseError m_ERR_INVALIDHWND, "The value passed to the hWnd property is not a valid window handle." End If End Property Public Property Get Left() As Long 'Returns the current position (in pixels) of the left edge of the window in the coordinate system of its parent window. If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then UpdateWindowRect Left = m_rctWindow.Left Else RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid." End If End Property Public Property Let Left(ByVal lngNewValue As Long) 'Moves the window such that its left edge falls at the position indicated '(measured in pixels, in the coordinate system of its parent window). If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then UpdateWindowRect With m_rctWindow apiMoveWindow m_hWnd, lngNewValue, .Top, .Right - .Left, .Bottom - .Top, True End With Else RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid." End If End Property '---------------------------------------------------- Public Property Get Top() As Long 'Returns the current position (in pixels) of the top edge of the window in the coordinate system of its parent window. If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then UpdateWindowRect Top = m_rctWindow.Top Else RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid." End If End Property Public Property Let Top(ByVal lngNewValue As Long) 'Moves the window such that its top edge falls at the position indicated '(measured in pixels, in the coordinate system of its parent window). If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then UpdateWindowRect With m_rctWindow apiMoveWindow m_hWnd, .Left, lngNewValue, .Right - .Left, .Bottom - .Top, True End With Else RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid." End If End Property '---------------------------------------------------- Public Property Get Width() As Long 'Returns the current width (in pixels) of the window. If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then UpdateWindowRect With m_rctWindow Width = .Right - .Left End With Else RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid." End If End Property Public Property Let Width(ByVal lngNewValue As Long) 'Changes the width of the window to the value provided (in pixels). If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then UpdateWindowRect With m_rctWindow apiMoveWindow m_hWnd, .Left, .Top, lngNewValue, .Bottom - .Top, True End With Else RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid." End If End Property '---------------------------------------------------- Public Property Get Height() As Long 'Returns the current height (in pixels) of the window. If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then UpdateWindowRect With m_rctWindow Height = .Bottom - .Top End With Else RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid." End If End Property Public Property Let Height(ByVal lngNewValue As Long) 'Changes the height of the window to the value provided (in pixels). If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then UpdateWindowRect With m_rctWindow apiMoveWindow m_hWnd, .Left, .Top, .Right - .Left, lngNewValue, True End With Else RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid." End If End Property Public Property Get Parent() As clsAutoCenter 'Returns the parent window as a clFormWindow object. 'For forms, this should be the Access MDI window. Dim fwParent As New clsAutoCenter Dim lngHWnd As Long If m_hWnd = 0 Then Set Parent = Nothing ElseIf apiIsWindow(m_hWnd) Then lngHWnd = apiGetParent(m_hWnd) fwParent.hWnd = lngHWnd Set Parent = fwParent Else RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid." End If Set fwParent = Nothing End Property ثانيا الموديول ولن يفرق اسم الموديول فى شئ '|---01/11/2021__________________________________________________________________________________________| '|___www.officena.net_______________________|___________________________________________________________| '| | | '| __ _ | _ +-----------officena-----------+ _ | '| \ `/ | | /o) | ||||| | (o\ | '| \__`! | / / | @(~O^O~)@ | \ \ | '| / ,' `-.__________________ | ( (_ | _ ----oOo--Moh--oOo----- _ | _) ) | '| '-'\_____ U `-. | ((\ \) +/o)----------3ssam---------(o\+ (/ /)) | '| \____()-=O=O=O=O=O=[]====--) | (\\\ \_/ / \ \_/ ///) | '| `.___ ,-----,_______...-' | \ / \ / | '| / .' | \____/________Mohammed Essam________\____/ | '| / .' | | '| / .' | 01/11/2021 | '| `-' | | '|_____www.officena.net_____________________|___________________________________________________________| '|_____Thank you for visiting https://www.officena.net__________________________________________________' Option Compare Database Option Explicit Private Type RECT X1 As Long Y1 As Long X2 As Long Y2 As Long End Type #If VBA7 Then Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long #Else Private Declare Function GetDesktopWindow Lib "user32" () As Long Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, Rectangle As RECT) As Boolean Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long #End If Private Const WU_LOGPIXELSX = 88 Private Const WU_LOGPIXELSY = 90 ' Call CenterForm(Me) ' Call CenterReport(Me) Sub CenterForm(F As Form) If F.PopUp = False Then Dim fw As New clsAutoCenter fw.hWnd = F.hWnd With fw .Top = (.Parent.Height - .Height) / 2 .Left = (.Parent.Width - .Width) / 2 End With Set fw = Nothing ElseIf F.PopUp = True Then Dim formWidth As Long, formHeight As Long Dim MaxWidth As Long, maxHeight As Long Dim ScreenWidth As Long, ScreenHeight As Long Dim formAllMarginsHeight As Long, formAllMarginsWidth As Long GetScreenResolution ScreenWidth, ScreenHeight ScreenWidth = ConvertPixelsToTwips(ScreenWidth, 0) ScreenHeight = ConvertPixelsToTwips(ScreenHeight, 0) MaxWidth = ScreenWidth * 0.6 maxHeight = ScreenHeight * 0.9 formAllMarginsHeight = F.WindowHeight - F.Section(acDetail).Height formAllMarginsWidth = F.Width formWidth = formAllMarginsWidth formHeight = formAllMarginsHeight If formHeight < F.WindowHeight Then formHeight = F.WindowHeight End If DoCmd.MoveSize (ScreenWidth - formWidth) / 2, (ScreenHeight - formHeight) / 2, formWidth, formHeight End If End Sub Sub CenterReport(R As Report) If R.PopUp = False Then Dim fw As New clsAutoCenter fw.hWnd = R.hWnd With fw .Top = (.Parent.Height - .Height) / 2 .Left = (.Parent.Width - .Width) / 2 End With Set fw = Nothing ElseIf R.PopUp = True Then Dim ReportWidth As Long, ReportHeight As Long Dim MaxWidth As Long, maxHeight As Long Dim ScreenWidth As Long, ScreenHeight As Long Dim ReportAllMarginsHeight As Long, ReportAllMarginsWidth As Long GetScreenResolution ScreenWidth, ScreenHeight ScreenWidth = ConvertPixelsToTwips(ScreenWidth, 0) ScreenHeight = ConvertPixelsToTwips(ScreenHeight, 0) MaxWidth = ScreenWidth * 0.6 maxHeight = ScreenHeight * 0.9 ReportAllMarginsHeight = R.WindowHeight - R.Section(acDetail).Height ReportAllMarginsWidth = R.Width ReportWidth = ReportAllMarginsWidth ReportHeight = ReportAllMarginsHeight If ReportHeight < R.WindowHeight Then ReportHeight = R.WindowHeight End If DoCmd.MoveSize (ScreenWidth - ReportWidth) / 2, (ScreenHeight - ReportHeight) / 2, ReportWidth, ReportHeight End If End Sub Function ConvertTwipsToPixels(lngTwips As Long, lngDirection As Long) As Long Dim lngPixelsPerInch As Long Const nTwipsPerInch = 1440 #If VBA7 Then Dim lngDC As LongPtr #Else Dim lngDC As Long #End If lngDC = GetDC(0) If (lngDirection = 0) Then lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSX) Else lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSY) End If lngDC = ReleaseDC(0, lngDC) ConvertTwipsToPixels = (lngTwips / nTwipsPerInch) * lngPixelsPerInch End Function Function ConvertPixelsToTwips(lngPixels As Long, lngDirection As Long) As Long Dim lngPixelsPerInch As Long Const nTwipsPerInch = 1440 #If VBA7 Then Dim lngDC As LongPtr #Else Dim lngDC As Long #End If lngDC = GetDC(0) If (lngDirection = 0) Then lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSX) Else lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSY) End If lngDC = ReleaseDC(0, lngDC) ConvertPixelsToTwips = (lngPixels * nTwipsPerInch) / lngPixelsPerInch End Function Private Sub GetScreenResolution(ByRef Width As Long, ByRef Height As Long) Dim R As RECT Dim RetVal As Long #If VBA7 Then Dim hWnd As LongPtr #Else Dim hWnd As Long #End If hWnd = GetDesktopWindow() RetVal = GetWindowRect(hWnd, R) Width = R.X2 - R.X1 Height = R.Y2 - R.Y1 End Sub ويتم استدعاء كود توسيط النماذج من خلال السطر الاتى فى حدث عند الفتح Call CenterForm(Me) ويتم استدعاء كود توسيط التقارير من خلال السطر الاتى فى حدث عند الفتح Call CenterReport(Me) فى حالة كانت PopUp = True يتم توسيط النماذج والتقارير فى وسط شاشة الحاسب الالى تمام تبعا لابعاد الشاشة اما فى حالة PopUp = False يتم توسيط النماذج والتقارير فى داخل اطار برنامج الاكسس نفسه والان اليكم المرفق بالمثال العملى AutoCentre.mdb
  2. -تجهيز مجلدات وملف الصوت الخطوة الاولى قم بانشاء مجلد جديد فى مسار قاعدة البيانات الحالى باسم ( Resurce ) الخطوة الثانية قم بفتح المجلد السابق وقم بانشاء مجلد جديد بداخله باسم ( Audio Files ) الخطوة الثالثة قم بنسخ ملف صوت الى المجلد ( Audio Files ) اما بامتداد wav , .mp3. --------------------- -تجهيز قاعدة البيانات الخطوة الاولى قم بانشاء وحدة نمطية باسم ( modPlayAudio ) وقم بلصق الاكواد الاتية فى هذه الوحدة النمطية Option Compare Database Option Explicit #If VBA7 And Win64 Then Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Private Declare PtrSafe Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal lBuffer As Long) As Long Private Declare PtrSafe Function playSound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long #Else Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal lBuffer As Long) As Long Private Declare Function playSound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long #End If Const SND_ALIAS_SYSTEMASTERISK As String = "SystemAsterisk" Const SND_ALIAS_SYSTEMDEFAULT As String = "SystemDefault" Const SND_ALIAS_SYSTEMEXCLAMATION As String = "SystemExclamation" Const SND_ALIAS_SYSTEMEXIT As String = "SystemExit" Const SND_ALIAS_SYSTEMHAND As String = "SystemHand" Const SND_ALIAS_SYSTEMQUESTION As String = "SystemQuestion" Const SND_ALIAS_SYSTEMSTART As String = "SystemStart" Const SND_ALIAS_SYSTEMWELCOME As String = "SystemWelcome" Const SND_ALIAS_YouGotMail As String = "MailBeep" ' playsound Params Const SND_LOOP = &H8 Const SND_ALIAS = &H10000 Const SND_NODEFAULT = &H2 ' silence if no sound associated with event Const SND_ASYNC = &H1 ' play async (don't freeze program while sound is playing) Private sMusicFile As String Public soundOn As Boolean Dim mp3Path As String Dim wavPath As String Dim Play As Variant Public Sub Sound_MP3(ByVal File$) sMusicFile = GetShortPath(File) Play = mciSendString("play " & sMusicFile, 0&, 0, 0) If Play <> 0 Then End If End Sub Public Sub Stop_MP3(Optional ByVal FullFile$) Play = mciSendString("close " & sMusicFile, 0&, 0, 0) End Sub Public Function GetShortPath(ByVal strFileName As String) As String Dim lngRes As Long, strPath As String strPath = String$(165, 0) lngRes = GetShortPathName(strFileName, strPath, 164) GetShortPath = Left$(strPath, lngRes) End Function Function IsFile(ByVal fName As String) As Boolean On Error Resume Next IsFile = ((GetAttr(fName) And vbDirectory) <> vbDirectory) End Function Public Function AudioFilePath() As String AudioFilePath = CurrentProject.Path & "\Resurce\Audio Files\" End Function Public Function PlayFile(ByVal FileName_ As String) Dim Msg As String Msg = ChrW(1578) & ChrW(1571) & ChrW(1603) & ChrW(1583) & ChrW(32) & ChrW(1605) & ChrW(1606) & ChrW(32) & ChrW(1608) & ChrW(1580) & _ ChrW(1608) & ChrW(1583) & ChrW(32) & ChrW(1605) & ChrW(1587) & ChrW(1575) & ChrW(1585) & ChrW(32) & ChrW(40) & ChrW(32) & _ ChrW(1605) & ChrW(1604) & ChrW(1601) & ChrW(32) & ChrW(47) & ChrW(32) & ChrW(1605) & ChrW(1604) & ChrW(1601) & ChrW(1575) & _ ChrW(1578) & ChrW(41) & ChrW(32) & ChrW(1575) & ChrW(1604) & ChrW(1589) & ChrW(1608) & ChrW(1578) & ChrW(32) & ChrW(46) & _ ChrW(13) & ChrW(10) & ChrW(1578) & ChrW(1571) & ChrW(1603) & ChrW(1583) & ChrW(32) & ChrW(1605) & ChrW(1606) & ChrW(32) & _ ChrW(1608) & ChrW(1580) & ChrW(1608) & ChrW(1583) & ChrW(32) & ChrW(40) & ChrW(32) & ChrW(1605) & ChrW(1604) & ChrW(1601) & _ ChrW(32) & ChrW(47) & ChrW(32) & ChrW(1605) & ChrW(1604) & ChrW(1601) & ChrW(1575) & ChrW(1578) & ChrW(41) & ChrW(32) & _ ChrW(1575) & ChrW(1604) & ChrW(1589) & ChrW(1608) & ChrW(1578) & ChrW(32) & ChrW(1601) & ChrW(1609) & ChrW(32) & ChrW(1575) & _ ChrW(1604) & ChrW(1605) & ChrW(1587) & ChrW(1575) & ChrW(1585) & ChrW(32) & ChrW(1575) & ChrW(1604) & ChrW(1605) & _ ChrW(1581) & ChrW(1583) & ChrW(1583) & ChrW(32) & ChrW(46) & ChrW(13) & ChrW(10) & ChrW(1578) & ChrW(1571) & _ ChrW(1603) & ChrW(1583) & ChrW(32) & ChrW(1605) & ChrW(1606) & ChrW(32) & ChrW(1575) & ChrW(1587) & ChrW(1605) & _ ChrW(32) & ChrW(32) & ChrW(40) & ChrW(32) & ChrW(1605) & ChrW(1604) & ChrW(1601) & ChrW(32) & ChrW(47) & ChrW(32) & _ ChrW(1605) & ChrW(1604) & ChrW(1601) & ChrW(1575) & ChrW(1578) & ChrW(41) & ChrW(32) & ChrW(1575) & ChrW(1604) & _ ChrW(1589) & ChrW(1608) & ChrW(1578) & ChrW(32) & ChrW(46) mp3Path = AudioFilePath & FileName_ & ".mp3" wavPath = AudioFilePath & FileName_ & ".wav" StopFile If IsFile(mp3Path) Then Sound_MP3 (mp3Path): Exit Function If IsFile(wavPath) Then playSound (wavPath), vbNull, SND_ALIAS Or SND_NODEFAULT Or SND_ASYNC: Exit Function If IsFile(mp3Path) = IsFile(wavPath) Then MsgBox (Msg), vbOKOnly + vbMsgBoxRtlReading + vbMsgBoxRight: Exit Function End Function Public Function StopFile() playSound vbNullString, ByVal 0&, SND_NODEFAULT Stop_MP3 (mp3Path) End Function الخطوة الثانية قم بانشاء نموذج باسم ( frmPlayAudio ) الخطوة الثالثة قم بانشاء مربع نص فى النموذج السابق باسم ( txtAudioFileName ) الخطوة الرابعة قم بانشاء زر أمر فى النموذج السابق باسم ( cmdPlay ) وفى حدث عند النقر ضع الكود الاتى soundOn = True: PlayFile (Me.txtAudioFileName) الخطوة الخامسة قم بانشاء زر أمر فى النموذج السابق باسم ( cmdStop ) وفى حدث عند النقر ضع الكود الاتى StopFile الخطوة السادسة فى حدث عند إغلاق النموذج ضع الكود الاتى StopFile الخطوة السابعة بعد حفظ ما سبق افتح النموذج وادخل فى مربع النص ( txtAudioFileName ) اسم ملف الصوت الموجود فى المسار المحدد بدون الامتداد مثلا لو ملف الصوت باسم : MyAudio.mp3 Or MyAudio.wav اسم ملف الصوت فى مربع النص ( txtAudioFileName ) يكون فى الشكل الاتى فقط : MyAudio والان جرب الضغط على زر الامر الخاص بالتشغيل تارة وزر الامر الخاص بالايقاف تارة أخرى طيب ملاحظة مهمه : الطريقة ودوال API هنا تقوم بتشغيل ملفات صوت من النوعين MP3 . WAV <<---< والله دلع شغل فاخر من الأخر تم صياغة الكود بمرونه مطلقة للتعامل مع الملف بغض النظر عن امتداد الملف اه والله زيمبئولك كده مش مصدق ليه مش بئولك شغل فاخر اللى مش عاجبه المسار لملفات الصوت او عاوز يغير مكانها او اسمها طبعا فى الموديول يغير فى الروتين ده على مزاجه AudioFilePath() انا شرحت بالتفصيل الممل اياك حد يقول لى عاوز مرفق أو مش عارف يطبق الشرح
  3. هل من الممكن تصدير المكتبات المستخدمة في المشروع الى جهاز آخر (أثناء عملية التثبيت مثلاً - على فرض أن المشروع تم تحزيمه بدقة ) حتى لو اختلفت فيه نسخة الأوفيس ؟ كون أن المكتبات هي ملفات معظمها Dll .... الخ من صيغ !!
  4. السلام عليكم ورحمة الله وبركاته التطبيق اهداء الى منتدانا الحبيب ورواد المنتدى العمل حتى يخرج بهذه الصورة يعلم الله وحده الجهد المبذول به اسال الله تعالى ان يتقبل هذا العمل صدقة جارية الى ما شاء الله تعالى ms access becomes an authorized e-invoicing solution provider in Saudi Arabia by www.officena.net Start your e-invoicing journey حسب متطلبات هيئة الزكاة والضريبة والجمارك السعودية يتم قراءة الرمز الناتج ان شاء الله عبر القارىء الرسمي الخاص بالهيئة ( تطبيق جوال ) حمل من هنا : التطبيق الرسمي لهيئة الزكاة والضريبة والجمارك يتم قراءة الرمز الناتج ان شاء الله عبر قارىء خاص ( تطبيق جوال ) حمل من هنا : تطبيق قرائة رمز الاستجابة طبقات لمتطلبات هيئة الزكاة والضريبة والجمارك التطبيق المقدم لكم تمت تجربته وهو متوافق مع النواتين 32 , 64 تم تصميم الاكواد داخل روتين عام ليسهل التعامل معها بكل سهولة ممكنة حاولت جاهدا جمع الاكواد المستخدمة فى موديول ليسهل نقله يتم التعامل مع الروتين باسناد فقط اسماء الحقول من النموذج المستخدم والتى يمكن تغير اسمائها تبعا لتصميمك كالاتى Call CreateInvoice(ID, SellerName, VatNo, TimeStamp, InvoiceWithVat, VatTotal) ID >>-----> اسم الحقل الدال على رقم الفاتورة وهذا ليتم تسمية ملف رمز الاستجابة الناتج بناء عليه SellerName >>-----> اسم الحقل الدال على اسم البائع VatNo >>-----> اسم الحقل الدال على الرقم الضريبي TimeStamp >>-----> اسم الحقل الدال على الوقت وتاريخ انشاء الفاتورة InvoiceWithVat >>-----> اسم الحقل الدال على القيمة الاجمالية للفاتورة VatTotal >>-----> اسم الحقل الدال على القيمة الاجمالية لمبلغ الضريبة فقط بعد تشفير البيانات يتم اسناد الشفرة الى متغير عام باسمstrHashCode والذى من خلاله يت حفظ البيانات المشفرة داخل الجدول تبعا لكل سجل ---------------------------------------------- الية العمل بعد اسناد اسماء الحقول الى الروتين يتم تمرير البيانات من تلك الحقول الى الملف التنفيذى الملحق مع القاعدة والذى بدورة يقوم بانشاء كل من 1- رمز الاستجابة السريع بعد تشفير البيانات طبقا للمطلبات from string to hex to base64 2- انشاء ملف نص به تشفير البيانات بعد ذلك تقوم باقى الاكواد بجلب البيانات المشفرة من ملف النص واسنادها الى المتغير الذى تم تخصيصه لذلك --------------------------------------------- تفاصيل الاكواد داخل الموديول كالتالى الروتين MkDir لعمل المجلدات عند الحاجة دوال الـ API الخاصة بـ ShellWait والمتوافقة مع كلتا النواتان 32 , 64 وتمت التجربة بنجاح على اوفيس 32 تارة واوفيس 64 تارة اخرى بفضل الله بنجاح حيث يتم ارسال البيانات من الحقول الى الملف التنفيذى الملحق من خلال الروتين Shell_n_Wait ليتم انشاء رمز الاستجابة السريع من خلال الروتين الخاص به وهو CreateInvoice وانشاء الملف النصى بجوار الملف التنفيذى فى نفس المسار لالحاق البيانات المشفرة طبقا للمطلبات from string to hex to base64 وبعد ذلك يتم جلب البيانات المشفرة من خلال الروتين ReadFileToText ولابد من استخلاص التشفير من خلال الروتين StripSpChars للاحتفاظ بالنص دون اى زيادات وبعد ذلك يتم الحاق البيانات المشفرة الى المتغير الذى قمت بتخصيصه لذلك وهو يحمل الاسم strHashCode والذى يتم الحاق البيانات من خلاله لكل سجل الى الحقل المخصص به للاحتفاظ بتلك الشفرة حسب طلبات السادة رواد المنتدى الكرام الملف التنفيذى تم عمله من خلال الفيجوال دوت نت ليقوم بتحويل النص طبقا للمطلبات from string to hex to base64 وتم دمج ملفات الـ Dll الخاصة بانشاء رمز الاستجابة بداخل الملف التنفيذى لسهولة التعامل معه من خلال الاكسس ليكون ملف تنفيذى واحد فقط يتم التعامل معه من خلال الـ Command Line دون الحاجة لتثبيت او تسجيل او الاستعانة بأى مكتبات خارجية او حتى ملحقة بالاكسس وذلك لسهولة نقل الموديول الى اى قاعدة دون التقيد باى مكتبات --------------------------------------------- تنبيه هام جدا جدا جدا بجوار قاعدة البيانات فى نفس مسارها مجلد باسم KSA-QR-Tool لايمكن تغيير اسم المجلد والا يحدث خلل وان استدعت الحاجة تغيير الاسم يجب ذلك داخل المدويول يتم كذلك انشاء ملف نصى اليا داخل المجلد KSA-QR-Tool لذلك يجب تحرى الحذر عند محاولة تغيير اسم المجلد داخل الموديول لذلك يرجى عدم محاولة تغير اسم المجلد كذلك داخل المجلد السابق ذكرة الملف التنفيذى KSAQR.exe لا تحاول تغيير اسم الملف لان الاكواد كذلك تتعامل مع هذا الملف من خلال اسمه كذلك لا يمكن نقل المجلد او الملف من مسار قاعدة البيانات الا بالتعديل على الاكواد وفى الختام فضلا وكرما وليس امرا الرجاء الاهتمام بالرد بما يفيد نتيجة تجربتكم الشخصية وتقييم تلك التجربة فلا تبخلوا علينا بذلك... لكم منا خالص الشكر واتمنى لكم تجربة ممتعة ومن يريد طريقتى والتى احبها وافضلها وتعلمتها من استاذى الجليل ومعلمى الجليل الاستاذ @jjafferr بتحميل الملف التنفيذى داخل القاعدة للتأكد دائما من عدم حذفه لا يتردد فى طلب ذلك فقط حاولت تقديم القاعدة بأبسط شكل حتى يقف كل من يريد استخدامها او نقلها الى تطبيقه الخاص على الاكواد المهمة فقط من خلال موديول واحد فقط تيسيرا وتسهيلا عليه وحتى تعم الفائدة هذه الاكواد المستخدمة فى الملف التنفيذى الذى تم انشاؤه من خلال الـ فيجوال دوت نت بناء على رغبة استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @ابوخليل لمن يريد التعلم من اكواد التشفير وبناء على طلب استاذى القدير @ابوآمنة Imports System.Drawing Imports System.IO Imports System.Text Imports QRCoder Module Module1 Sub Main() Try Dim sellerName As String = "" Dim vatNumber As String = "" Dim timeStamp As String = "" Dim invoiceTotal As String = "" Dim vatTotal As String = "" Dim imagePath As String = "" Dim filePath As String = "" If My.Application.CommandLineArgs.Count >= 6 Then sellerName = My.Application.CommandLineArgs(0) vatNumber = My.Application.CommandLineArgs(1) timeStamp = My.Application.CommandLineArgs(2) invoiceTotal = My.Application.CommandLineArgs(3) vatTotal = My.Application.CommandLineArgs(4) imagePath = My.Application.CommandLineArgs(5) filePath = My.Application.CommandLineArgs(6) Else Environment.Exit(0) End If If Not String.IsNullOrEmpty(filePath) Then File.WriteAllText(filePath, String.Join(" ", sellerName, vatNumber, timeStamp, invoiceTotal, vatTotal), Encoding.UTF8) End If End Dim tlvInvoice = CreateInvoice(sellerName, vatNumber, timeStamp, invoiceTotal, vatTotal) Dim qrGenerator As New QRCodeGenerator() Dim qrData As QRCodeData = qrGenerator.CreateQrCode(tlvInvoice, QRCodeGenerator.ECCLevel.Q) Dim qrCode As QRCode = New QRCode(qrData) Dim qrCodeImage As Bitmap = qrCode.GetGraphic(20) qrCodeImage.Save(imagePath) If Not String.IsNullOrEmpty(filePath) Then File.WriteAllText(filePath, tlvInvoice, Encoding.UTF8) End If Catch ex As Exception End Try End Sub Function CreateInvoice(sellerName As String, vatNumber As String, timeStamp As String, invoiceTotal As String, vatTotal As String) As String Dim invoiceHex As String = "" For i = 1 To 5 Dim txt As String = "" Select Case i Case 1 txt = sellerName Case 2 txt = vatNumber Case 3 txt = timeStamp Case 4 txt = invoiceTotal Case 5 txt = vatTotal End Select Dim hexTxt As String = StringToHex(txt) Dim hexLen As String = Hex(Encoding.UTF8.GetBytes(txt).Length) If hexLen.Length = 1 Then hexLen = "0" & hexLen End If invoiceHex = invoiceHex & "0" & i & hexLen & hexTxt Next Return HexToBase64(invoiceHex) End Function Function StringToHex(txt As String) As String Dim b As Byte() = Encoding.UTF8.GetBytes(txt) Return BitConverter.ToString(b).Replace("-", "") End Function Function HexToBase64(txt As String) As String Dim bytes = New Byte((txt.Length \ 2) - 1) {} For i = 0 To bytes.Length - 1 Dim mi = txt.Substring(i * 2, 2) bytes(i) = Convert.ToByte(mi, 16) Next i Return Convert.ToBase64String(bytes) End Function End Module E-Invoicing.zip Ksa Qr 32x 64x 2007 to 2021 _Last Version.zip
  5. ذكريات و تحديث اذاعات البث المباشر تحديث المرفق اعادة تفعيل الـ Shift تقليل حجم مستوى الصوت عتج الفتح ازالة روابط اذاعات بث الغناء اخص بكل الشكر والعرفان بالجميل اخى الحبيب الاستاذ @Amr Ashraf لتنبيهى لتدارك خطأى عبر نشر اذاعات بث الغتاء اللهم انى استغفرك واتوب واليك اللهم اغفر لى يارب وارحمتى واعفو عنى يارب العالمين Radio (V2).mdb
  6. السلام عليكم ورحمة والله تعالى وبركاته طيب ببساطه انظر للسلسلة النصية الاتية "Moh8202281012343434" ونريد التعديل عليها لتظهر بهذا الشكل "Moh-820-228-101-234-343-4" او بهذا الشكل "Moh,820,228,101,234,343,4" او بهذا الشكل Moh820/228101/234343/4 يتم عمل ذلك من خلال الكود الاتى Function ReFormat(ByVal strText As String, Optional strSymbol As String = "-", Optional intCountDigits As Integer = 3) Dim i As Long ReFormat = "" For i = 0 To Len(strText) - 1 Step intCountDigits If i = 0 Then ReFormat = Mid(strText, i + 1, intCountDigits) Else ReFormat = ReFormat & strSymbol & Mid(strText, i + 1, intCountDigits) End If Next i End Function syntax code ReFormat(string ,Symbol, Count Digits) Result By default syntax used ReFormat(string) Symbol >-->> - Count Digits >-->> 3 اذا من خلال استدعاء الكود عن طريق البنية المفضلة الاتية: ReFormat(string) تحصل على اضافة العلامة - بعد كل 3 مواضع فى السلسلة النصية اما اذا اردت التعديل فى شكل الرمز وعدد المواضع يمكنك استخدام الكود الاتى : ReFormat(string ,Symbol, Count Digits) مثلا لو اردت استخدام الرمز $ بدلا من الرمز - وتريد وضع الرمز فى السلسلة النصية بعد كل خمس مواضع يكون الكود كالأتى: ReFormat(string ,"$", 5)
  7. السلام عليكم ورحمة الله تعالى وبركاته يسأل البعض عن عدم حفظ البيانات الإ بإستكمال الحقول المطلوبة يمكن ذلك من خلال الفكرة الاتية ولكن بشرط اسم العنصر المطلوب ( الاجبارى) يجب وضع الرمز * فى الـ Tag الخاصة به كما بالصورة الاتية لاننى وضعت الاكواد فى الموديول تعتمد عليها والان الاكواد داخل الموديول 'RequiredData Function RequiredData(ByVal frm As Form) On Error Resume Next Dim ctl As Control Dim err As Integer For Each ctl In frm.Controls Select Case ctl.ControlType Case acTextBox, acComboBox, acListBox, acCheckBox, acOptionButton, acOptionGroup: 'If ctl.StatusBarText = "*" Then If ctl.Tag = "*" Then If IsNull(ctl) Or ctl = "" Or ctl = Null Then ctl.BackColor = 15531489 ctl.SetFocus err = err + 1: MsgBox "Please fill in the " & ctl.Controls(0).Caption: Exit Function Exit For Exit Function Else ctl.BackColor = 16777215 End If End If End Select Set ctl = Nothing Next ctl End Function ويتم استدعاء الكود من خلال Call RequiredData(Me) اترككم مع الاستمتاع بالتجربـة وفى انتظار ارائكم Required data (2).mdb
  8. بداية دعونا نتفق طالما فكرنا فى الموضوع ده ووصلنا له اذن نريد اضافة حماية لتطبيقاتنا طالما سوف نتحدث عن الحماية فلسوف يتم ان شاء الله العمل على افكار تطبيق ذلك خطوة بعد خطوة تدريجيا للارتقاء بالتوازى برفع مستوى الحماية مع الانتهاء من التطبيق مشروحا خطوة بعد خطوة تفصيليا 1- كل اسماء الجداول والنماذج والاستعلامات والموديول التى تخص المستخدمين ونظام الحماية سوف تبدأ بالمقطع Usys حتى يتعامل معها االاكسس على انها من كائنات النظام فيخفيها اليا عن المستخدم العادى 2- تشفير / فك تشفير البيانات التى تخص تطبيق نظام الصلاحيات وبما اننا سوف نبدأ بتلك الجزئية يستوجب تقديم الشكـر والامتنان لاستاذى الجليل ومعلمى القدير الدكتور @SEMO.Pa3x لاننى ان شاء الله سوف استخدم نظام التشفير الذى تقدم به استاذى الجليل اولا ـــــــــ الروتين المستخدم فى تشفير الكلمات والذى يتم وضعه فى موديول Function Encoder(ByVal strWordDecrypt As String) As String Dim iIndex As Integer Dim iEncoder As Integer Dim iEncodedVal As Integer Randomize Encoder = "" For iIndex = 1 To Len(strWordDecrypt) Do iEncoder = Int(98 * Rnd + 89) iEncodedVal = Asc(Mid(strWordDecrypt, iIndex, 1)) Xor iEncoder Loop While iEncodedVal = 1000 Or iEncodedVal < 99 Encoder = Encoder & Chr(iEncodedVal) & Chr(iEncoder) Next iIndex End Function ويتم استدعاءه كلاتى Encoder(text) حيث ان text هو النص المراد تشفيره أو انه اسم الحقل ( تيكست بوكس , كمبو بوكس ..) المراد تشفير القيم الموجوده بهم ------------------- العملية العكسية وهى فك تشفير الكلمات واعادتها الى وضعها الطبيعى الروتين المستخدم فى فك تشفير الكلمات والذى يتم وضعه فى موديول Function Decodeder(ByVal strWordEncrypt As String) As String Dim iIndex As Integer Dim iDecodedVal As Integer Decodeder = "" For iIndex = 1 To Len(strWordEncrypt) Step 2 iDecodedVal = Asc(Mid(strWordEncrypt, iIndex, 1)) Xor Asc(Mid(strWordEncrypt, iIndex + 1, 1)) Decodeder = Decodeder & Chr(iDecodedVal) Next iIndex End Function ويتم استدعاءه كلاتى Decodeder(EncoderText) حيث ان EncoderText هو النص المشفر المراد فك تشفيره أو انه اسم الحقل ( تيكست بوكس , كمبو بوكس ..) المراد فك تشفير القيم الموجوده بهم واخيرا المرفق Encrypt&Decrypt.mdb
  9. السلام عليكم ورحمة الله تعالى وبركاته احيانا نريد التأكد من وجود قيمة محددة فى حقل محدد داخل جدول محدد وذلك حتى نتأكد من عدم حدوث تكرار وطبعا كالعادة سوف اقدم لكم اليوم فكرتى المتواضعة فى هذا الشأن من خلال استخدام وظيفة عامة تعمل كروتين من خلال وحدة نمطية بحيث يتم اسناد القيم التى تخص كل من القيمة واسم الحقل واسم الجدول الى متغيرات عامة ليتم الفحص يعنى مثل ما سوينا من قبل مع المعرف الخاص البرمجى هنا فى هذا الموضوع '|-----------------------------------------------------------| '|---15/09/1443-------16/04/2022_____________________________| '|___www.officena.net________________________________________| '| | '| _ +-----------officena-----------+ _ | '| /o) | ||||| | (o\ | '| / / | @(~O^O~)@ | \ \ | '| ( (_ | _ ----oOo--Moh--oOo----- _ | _) ) | '| ((\ \) +/o)----------3ssam---------(o\+ (/ /)) | '| (\\\ \_/ / \ \_/ ///) | '| \ / \ / | '| \____/________Mohammed Essam________\____/ | '| 15/09/1443 | '| 16/04/2022 | '| | '|_____www.officena.net______________________________________| '|_____Thank you for visiting https://www.officena.net_______| '|-----------------------------------------------------------| '======Check Input Exist By Input Type======================================================================================================================================' ' ____ __ ____ ____ __ ____ ____ __ ____ ______ _______ _______ __ ______ _______ .__ __. ___ .__ __. _______ .___________. ' ' \ \ / \ / / \ \ / \ / / \ \ / \ / / / __ \ | ____|| ____|| | / || ____|| \ | | / \ | \ | | | ____|| | ' ' \ \/ \/ / \ \/ \/ / \ \/ \/ / | | | | | |__ | |__ | | | ,----'| |__ | \| | / ^ \ | \| | | |__ `---| |----` ' ' \ / \ / \ / | | | | | __| | __| | | | | | __| | . ` | / /_\ \ | . ` | | __| | | ' ' \ /\ / \ /\ / \ /\ / __| `--' | | | | | | | | `----.| |____ | |\ | / _____ \ __| |\ | | |____ | | ' ' \__/ \__/ \__/ \__/ \__/ \__/ (__)\______/ |__| |__| |__| \______||_______||__| \__| /__/ \__\ (__)__| \__| |_______| |__| ' ' ' '===========================================================================================================================================================================' Public Function CheckInputExist( _ ByRef strFieldName As String, _ ByRef strTableName As String, _ ByVal strObjectContainFieldValue) As Boolean On Error GoTo ErrorHandler Dim strFormName As Access.Form Dim stLinkCriteria As String Dim strMsgTitel As String Dim strMsgPrt1 As String Dim strMsgPrt2 As String Dim strErrMsgTitel As String Dim strErrMsg As String Set strFormName = Screen.ActiveForm strMsgPrt1 = ChrW("1578") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1593") & ChrW("1579") & ChrW("1608") & ChrW("1585") & ChrW("32") & ChrW("1593") & ChrW("1604") & ChrW("1609") & ChrW("32") & ChrW("46") & ChrW("46") & ChrW("13") & ChrW("10") & ChrW("40") & ChrW("160") strMsgPrt2 = ChrW("32") & ChrW("41") & ChrW("13") & ChrW("10") & ChrW("1587") & ChrW("1608") & ChrW("1601") & ChrW("32") & ChrW("1610") & ChrW("1578") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1575") & ChrW("1606") & ChrW("1578") & ChrW("1602") & ChrW("1575") & ChrW("1604") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1609") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1587") & ChrW("1580") & ChrW("1604") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1575") & ChrW("1606") If Len(strObjectContainFieldValue) = 0 Or IsNull(strObjectContainFieldValue) Then Exit Function Select Case FieldTypeName(strFieldName, strTableName) Case Is = "Text": stLinkCriteria = strFieldName & "= '" & strObjectContainFieldValue & "'" Case Is = "Date/Time": stLinkCriteria = strFieldName & "= #" & Format(strObjectContainFieldValue, "dd/mm/yyyy") & "#" Case Is = "Long Integer": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue Case Is = "Integer": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue Case Is = "Byte": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue Case Is = "Single": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue Case Is = "Double": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue Case Is = "Decimal": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue End Select If DCount("*", strTableName, stLinkCriteria) > 0 Then MsgBox$ strMsgPrt1 & strObjectContainFieldValue & strMsgPrt2, vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, "" strFormName.Undo strFormName.Recordset.FindFirst stLinkCriteria Else End If procDone: Exit Function ErrorHandler: strErrMsgTitel = ChrW("1582") & ChrW("1591") & ChrW("1571") & ChrW("32") & ChrW("1601") & ChrW("1609") & ChrW("32") & ChrW("1606") & ChrW("1608") & ChrW("1593") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1576") & ChrW("1576") & ChrW("1610") & ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") strErrMsg = ChrW("1604") & ChrW("1602") & ChrW("1583") & ChrW("32") & ChrW("1581") & ChrW("1575") & ChrW("1608") & ChrW("1604") & ChrW("1578") & ChrW("32") & ChrW("1573") & _ ChrW("1583") & ChrW("1582") & ChrW("1575") & ChrW("1604") & ChrW("32") & ChrW("1606") & ChrW("1608") & ChrW("1593") & ChrW("32") & ChrW("1576") & ChrW("1610") & _ ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") & ChrW("32") & ChrW("1594") & ChrW("1610") & ChrW("1585") & ChrW("32") & ChrW("1589") & ChrW("1581") & _ ChrW("1610") & ChrW("1581") & ChrW("46") & ChrW("46") & ChrW("46") & ChrW("13") & ChrW("10") & ChrW("32") & ChrW("1606") & ChrW("1608") & ChrW("1593") & _ ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1576") & ChrW("1610") & ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") & ChrW("32") & ChrW("1575") & _ ChrW("1604") & ChrW("1605") & ChrW("1587") & ChrW("1578") & ChrW("1582") & ChrW("1583") & ChrW("1605") & ChrW("32") & ChrW("1607") & ChrW("1608") & ChrW("32") & _ ChrW("40") & ChrW("32") & FieldTypeName(strFieldName, strTableName) & ChrW("32") & ChrW("41") & ChrW("13") & ChrW("10") & ChrW("1605") & ChrW("1606") & ChrW("32") & _ ChrW("1601") & ChrW("1590") & ChrW("1604") & ChrW("1603") & ChrW("32") & ChrW("1602") & ChrW("1605") & ChrW("32") & ChrW("1576") & ChrW("1573") & ChrW("1583") & _ ChrW("1582") & ChrW("1575") & ChrW("1604") & ChrW("32") & ChrW("1576") & ChrW("1610") & ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") & ChrW("32") & _ ChrW("1578") & ChrW("1578") & ChrW("1591") & ChrW("1575") & ChrW("1576") & ChrW("1602") & ChrW("32") & ChrW("1605") & ChrW("1593") & ChrW("32") & ChrW("1606") & _ ChrW("1608") & ChrW("1593") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1576") & ChrW("1610") & ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") _ & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1605") & ChrW("1587") & ChrW("1578") & ChrW("1582") & ChrW("1583") & ChrW("1605") Select Case Err.Number Case Is = 2471: MsgBox$ strErrMsg, vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, strErrMsgTitel Case Is = 3075: MsgBox$ strErrMsg, vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, strErrMsgTitel Case Else MsgBox$ Err.Number & ": " & Err.Description End Select Resume procDone End Function Public Function FieldTypeName(ByRef strFieldName As String, ByRef strTableName As String) As String Dim db As DAO.Database Dim objRecordset As DAO.Recordset Dim i As Integer Set objRecordset = CurrentDb.OpenRecordset(strTableName) For i = 0 To objRecordset.Fields.Count - 1 If strFieldName = objRecordset.Fields(i).Name Then Dim strReturn As String Select Case CLng(objRecordset.Fields.Item(i).Type) 'fld.Type is Integer, but constants are Long. Case dbBoolean: strReturn = "Yes/No" ' 1 Case dbByte: strReturn = "Byte" ' 2 Case dbInteger: strReturn = "Integer" ' 3 Case dbLong ' 4 If (objRecordset.Fields.Item(i).Attributes And dbAutoIncrField) = 0& Then strReturn = "Long Integer" Else strReturn = "AutoNumber" End If Case dbCurrency: strReturn = "Currency" ' 5 Case dbSingle: strReturn = "Single" ' 6 Case dbDouble: strReturn = "Double" ' 7 Case dbDate: strReturn = "Date/Time" ' 8 Case dbBinary: strReturn = "Binary" ' 9 (no interface) Case dbText '10 If (objRecordset.Fields.Item(i).Attributes And dbFixedField) = 0& Then strReturn = "Text" Else strReturn = "Text (fixed width)" '(no interface) End If Case dbLongBinary: strReturn = "OLE Object" '11 Case dbMemo '12 If (objRecordset.Fields.Item(i).Attributes And dbHyperlinkField) = 0& Then strReturn = "Memo" Else strReturn = "Hyperlink" End If Case dbGUID: strReturn = "GUID" '15 'Attached tables only: cannot create these in JET. Case dbBigInt: strReturn = "Big Integer" '16 Case dbVarBinary: strReturn = "VarBinary" '17 Case dbChar: strReturn = "Char" '18 Case dbNumeric: strReturn = "Numeric" '19 Case dbDecimal: strReturn = "Decimal" '20 Case dbFloat: strReturn = "Float" '21 Case dbTime: strReturn = "Time" '22 Case dbTimeStamp: strReturn = "Time Stamp" '23 'Constants for complex types don't work prior to Access 2007 and later. Case 101&: strReturn = "Attachment" 'dbAttachment Case 102&: strReturn = "Complex Byte" 'dbComplexByte Case 103&: strReturn = "Complex Integer" 'dbComplexInteger Case 104&: strReturn = "Complex Long" 'dbComplexLong Case 105&: strReturn = "Complex Single" 'dbComplexSingle Case 106&: strReturn = "Complex Double" 'dbComplexDouble Case 107&: strReturn = "Complex GUID" 'dbComplexGUID Case 108&: strReturn = "Complex Decimal" 'dbComplexDecimal Case 109&: strReturn = "Complex Text" 'dbComplexText Case Else: strReturn = "unknown" End Select End If Next i FieldTypeName = strReturn End Function يتم استدعاء الوظيقة بشكل عام من خلال الكود الاتى Call CheckInputExist("FieldName", "TableName", Me.txtBox) وأخيرا المرفق للتجربة ملاحظة : تم تعديل المرفق والكود بناء على رد استاذى الجليل الباش مهندس @Moosak التعديل النهائى بتحديث المرفق بتاريخ يوم السبت 22 رمضان 1443 هـ , 23 -أبريل -2022 م تم إضافة وظيقة للتعرف نوع البيانات المستخدم فى الحقل داخل الجدول Check Input Exist.accdb
  10. السلام عليكم ورحمة الله تعالى وبركاته تحية طيبة عطرة موديول واحد قمت بتجميع الدوال الهامة للتاريخ بحيث يسهل استخدامها مع الاخذ فى الاعتبار بمرونة التحكم الشامل فى كل كبيرة وصغيره بسم الله الرحمن الرحيم وعلى بركة الله طالما سوف نتطرق الى التاريخ والتعامل معه لابد أن نبدأ على خطى استاذى الجليل و معلمى القدير و والدى الحبيب الاستاذ @jjafferr واقتبس من استاذى الجليل تلك الكلمات التى لابد ان تعلق فى اذهان كل من يتعامل مع دوال والتاريخ الروتين رقم 1 DateFormat Function DateFormat(ByVal varDate As Variant) As String 'Purpose: Return a delimited string in the date format used natively by JET SQL. 'Argument: A date/time value. 'Note: Returns just the date format if the argument has no time component, ' or a date/time format if it does. 'Author: Allen Browne. allen@allenbrowne.com, June 2006. ' 'calling the Function: DateFormat(The_Date_Field) 'a = dlookup("[some field]","some table","[id]=" & me.id & " And [Date_Field]=" & DateFormat(The_Date_Field)) ' If IsDate(varDate) Then If DateValue(varDate) = varDate Then DateFormat = Format$(varDate, "\#mm\/dd\/yyyy\#") Else DateFormat = Format$(varDate, "\#mm\/dd\/yyyy hh\:nn\:ss\#") End If End If End Function الروتين رقم 2 ToWhat يقوم بعمل التحويل من التاريخ الميلادى الى الهجرى والعكس ولكن لابد من عمل جدول باسم tblAdjustHjriDate يحتوى على حقل رقمى باسم AdjustDay وذلك لوضع الفرق بالايام بين التاريخين حسب كل شهر للحصول على النتيجة الصحيحة ' ______ ______ .__ __. ____ ____ _______ .______ .___________. __ .__ __. _______ ' / | / __ \ | \ | | \ \ / / | ____|| _ \ | || | | \ | | / _____| ' | ,----'| | | | | \| | \ \/ / | |__ | |_) | `---| |----`| | | \| | | | __ ' | | | | | | | . ` | \ / | __| | / | | | | | . ` | | | |_ | ' | `----.| `--' | | |\ | \ / | |____ | |\ \----. | | | | | |\ | | |__| | ' \______| \______/ |__| \__| \__/ |_______|| _| `._____| |__| |__| |__| \__| \______| ' _______ ___ .___________. _______ _______ .______ ______ .___ ___. ' | \ / \ | || ____| | ____|| _ \ / __ \ | \/ | ' | .--. | / ^ \ `---| |----`| |__ | |__ | |_) | | | | | | \ / | ' | | | | / /_\ \ | | | __| | __| | / | | | | | |\/| | ' | '--' | / _____ \ | | | |____ | | | |\ \----.| `--' | | | | | ' |_______/ /__/ \__\ |__| |_______| |__| | _| `._____| \______/ |__| |__| ' _______ .______ _______ _______ ______ .______ __ ___ .__ __. .___________. ______ ' / _____|| _ \ | ____| / _____| / __ \ | _ \ | | / \ | \ | | | | / __ \ ' | | __ | |_) | | |__ | | __ | | | | | |_) | | | / ^ \ | \| | `---| |----`| | | | ' | | |_ | | / | __| | | |_ | | | | | | / | | / /_\ \ | . ` | | | | | | | ' | |__| | | |\ \----.| |____ | |__| | | `--' | | |\ \----.| | / _____ \ | |\ | | | | `--' | ' \______| | _| `._____||_______| \______| \______/ | _| `._____||__| /__/ \__\ |__| \__| |__| \______/ ' __ __ __ __ .______ __ ' | | | | | | | | | _ \ | | ' | |__| | | | | | | |_) | | | ' | __ | | | .--. | | | / | | ' | | | | | | | `--' | | |\ \----.| | ' |__| |__| |__| \______/ | _| `._____||__| ' ______ .______ .______ ___ ______ __ ___ ' / __ \ | _ \ | _ \ / \ / || |/ / ' | | | | | |_) | | |_) | / ^ \ | ,----'| ' / ' | | | | | / | _ < / /_\ \ | | | < ' | `--' | | |\ \----. | |_) | / _____ \ | `----.| . \ ' \______/ | _| `._____| |______/ /__/ \__\ \______||__|\__\ ' Public Function ToWhat(ByRef myData As String, To_Hijri_Milady As String) As String Dim CorctAdjustDay As Integer Dim SavedCal As Integer Dim strD As Date Dim strS As String On Error GoTo ErrorHandler 'to call the Function 'Hijri to Milady 'txt Milady date = ToWhat(txt Hijri date, "H") 'Milady to Hijri 'txt Hijri date = ToWhat(txt Milady date, "M") CorctAdjustDay = DLookup("[AdjustDay]", "tblAdjustHjriDate") If To_Hijri_Milady = "M" Then myData = Trim(Format(DateAdd("d", -1 * CorctAdjustDay, myData), "dd/mm/yyyy")) SavedCal = Calendar VBA.Calendar = 1 strD = CDate(myData) VBA.Calendar = 0 Else myData = Trim(Format(DateAdd("d", CorctAdjustDay, myData), "dd/mm/yyyy")) SavedCal = Calendar VBA.Calendar = 0 strD = CDate(myData) VBA.Calendar = 1 End If strS = CStr(strD) ToWhat = Format(strS, "dd/mm/yyyy") VBA.Calendar = SavedCal ErrorHandlerExit: Exit Function ErrorHandler: If Err = 13 Then MsgBox "Wrong Data", vbOKOnly + vbMsgBoxRight + vbMsgBoxRtlReading, "Wrong" Exit Function 'Resume Next Else Resume ErrorHandlerExit End If End Function الروتين رقم 3 MyNo للتحكم فى شكل ظهور الارقام بالعربية او بالهندية من خلال استخدام اليونيكود ' __ ___ .__ __. _______ __ __ ___ _______ _______ ______ _______ .__ __. __ __ .___ ___. .______ _______ .______ _______. ' | | / \ | \ | | / _____|| | | | / \ / _____|| ____| / __ \ | ____| | \ | | | | | | | \/ | | _ \ | ____|| _ \ / | ' | | / ^ \ | \| | | | __ | | | | / ^ \ | | __ | |__ | | | | | |__ | \| | | | | | | \ / | | |_) | | |__ | |_) | | (----` ' | | / /_\ \ | . ` | | | |_ | | | | | / /_\ \ | | |_ | | __| | | | | | __| | . ` | | | | | | |\/| | | _ < | __| | / \ \ ' | `----. / _____ \ | |\ | | |__| | | `--' | / _____ \ | |__| | | |____ | `--' | | | | |\ | | `--' | | | | | | |_) | | |____ | |\ \----..----) | ' |_______|/__/ \__\ |__| \__| \______| \______/ /__/ \__\ \______| |_______| \______/ |__| |__| \__| \______/ |__| |__| |______/ |_______|| _| `._____||_______/ ' Public Function MyNo(ByVal strNo As String, ByVal strLng As String) 'to call the Function 'To Arabic 'txtNoToAR=MyNo(txtNo,"Ar") 'To English 'txtNoTOEng=MyNo(txtNo,"En") If strLng = "Ar" Then strNo = Replace(strNo, ChrW(48), ChrW(1632)) strNo = Replace(strNo, ChrW(49), ChrW(1633)) strNo = Replace(strNo, ChrW(50), ChrW(1634)) strNo = Replace(strNo, ChrW(51), ChrW(1635)) strNo = Replace(strNo, ChrW(52), ChrW(1636)) strNo = Replace(strNo, ChrW(53), ChrW(1637)) strNo = Replace(strNo, ChrW(54), ChrW(1638)) strNo = Replace(strNo, ChrW(55), ChrW(1639)) strNo = Replace(strNo, ChrW(56), ChrW(1640)) strNo = Replace(strNo, ChrW(57), ChrW(1641)) MyNo = strNo ElseIf strLng = "En" Then strNo = Replace(strNo, ChrW(1632), ChrW(48)) strNo = Replace(strNo, ChrW(1633), ChrW(49)) strNo = Replace(strNo, ChrW(1634), ChrW(50)) strNo = Replace(strNo, ChrW(1635), ChrW(51)) strNo = Replace(strNo, ChrW(1636), ChrW(52)) strNo = Replace(strNo, ChrW(1637), ChrW(53)) strNo = Replace(strNo, ChrW(1638), ChrW(54)) strNo = Replace(strNo, ChrW(1639), ChrW(55)) strNo = Replace(strNo, ChrW(1640), ChrW(56)) strNo = Replace(strNo, ChrW(1641), ChrW(57)) MyNo = strNo End If End Function الروتين رقم 4 MnthName اسماء الشهور الهجرى - العربى( الميلادى) - الانجليزيى( الميلادى) - اختصارالانجليزيى( الميلادى) - القبطى - السريانى ' .__ __. ___ .___ ___. _______ _______. ______ _______ .___________. __ __ _______ .___ ___. ______ .__ __. .___________. __ __ _______. ' | \ | | / \ | \/ | | ____| / | / __ \ | ____| | || | | | | ____| | \/ | / __ \ | \ | | | || | | | / | ' | \| | / ^ \ | \ / | | |__ | (----` | | | | | |__ `---| |----`| |__| | | |__ | \ / | | | | | | \| | `---| |----`| |__| | | (----` ' | . ` | / /_\ \ | |\/| | | __| \ \ | | | | | __| | | | __ | | __| | |\/| | | | | | | . ` | | | | __ | \ \ ' | |\ | / _____ \ | | | | | |____ .----) | | `--' | | | | | | | | | | |____ | | | | | `--' | | |\ | | | | | | | .----) | ' |__| \__| /__/ \__\ |__| |__| |_______||_______/ \______/ |__| |__| |__| |__| |_______| |__| |__| \______/ |__| \__| |__| |__| |__| |_______/ ' Public Function MnthName(ByVal dtAnyDate As Date, ByVal strLng As String) 'to call the Function 'To Hijri 'txtMonthNameHijri =MnthName(txtDate,"HJ") 'To Arabic 'txtMonthNameArabic =MnthName(txtDate,"Ar") 'To English 'txtMonthNameEnglish =MnthName(txtDate,"En") 'To English Short 'txtMonthNameEnglish =MnthName(txtDate,"EnShrt") 'To Coptic 'txtMonthNameCoptic =MnthName(txtDate,"Cpti") 'To Syriac 'txtMonthNameSyriac =MnthName(txtDate,"Syr") Dim str01 As String Dim str02 As String Dim str03 As String Dim str04 As String Dim str05 As String Dim str06 As String Dim str07 As String Dim Str08 As String Dim Str09 As String Dim Str10 As String Dim Str11 As String Dim Str12 As String If strLng = "HJ" Then str01 = ChrW("1605") & ChrW("1581") & ChrW("1585") & ChrW("1605") str02 = ChrW("1589") & ChrW("1601") & ChrW("1585") str03 = ChrW("1585") & ChrW("1576") & ChrW("1610") & ChrW("1593") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1571") & ChrW("1608") & ChrW("1604") str04 = ChrW("1585") & ChrW("1576") & ChrW("1610") & ChrW("1593") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1570") & ChrW("1582") & ChrW("1585") str05 = ChrW("1580") & ChrW("1605") & ChrW("1575") & ChrW("1583") & ChrW("1610") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1571") & ChrW("1608") & ChrW("1604") & ChrW("1610") str06 = ChrW("1580") & ChrW("1605") & ChrW("1575") & ChrW("1583") & ChrW("1610") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1570") & ChrW("1582") & ChrW("1585") & ChrW("1577") str07 = ChrW("1585") & ChrW("1580") & ChrW("1576") Str08 = ChrW("1588") & ChrW("1593") & ChrW("1576") & ChrW("1575") & ChrW("1606") Str09 = ChrW("1585") & ChrW("1605") & ChrW("1590") & ChrW("1575") & ChrW("1606") Str10 = ChrW("1588") & ChrW("1608") & ChrW("1575") & ChrW("1604") Str11 = ChrW("1584") & ChrW("1608") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1602") & ChrW("1593") & ChrW("1583") & ChrW("1577") Str12 = ChrW("1584") & ChrW("1608") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1581") & ChrW("1580") & ChrW("1577") ElseIf strLng = "Ar" Then str01 = ChrW("1610") & ChrW("1606") & ChrW("1575") & ChrW("1610") & ChrW("1585") str02 = ChrW("1601") & ChrW("1576") & ChrW("1585") & ChrW("1575") & ChrW("1610") & ChrW("1585") str03 = ChrW("1605") & ChrW("1575") & ChrW("1585") & ChrW("1587") str04 = ChrW("1571") & ChrW("1576") & ChrW("1585") & ChrW("1610") & ChrW("1604") str05 = ChrW("1605") & ChrW("1575") & ChrW("1610") & ChrW("1608") str06 = ChrW("1610") & ChrW("1608") & ChrW("1606") & ChrW("1610") & ChrW("1577") str07 = ChrW("1610") & ChrW("1608") & ChrW("1604") & ChrW("1610") & ChrW("1577") Str08 = ChrW("1571") & ChrW("1594") & ChrW("1587") & ChrW("1591") & ChrW("1587") Str09 = ChrW("1587") & ChrW("1576") & ChrW("1578") & ChrW("1605") & ChrW("1576") & ChrW("1585") Str10 = ChrW("1575") & ChrW("1603") & ChrW("1578") & ChrW("1608") & ChrW("1576") & ChrW("1585") Str11 = ChrW("1606") & ChrW("1608") & ChrW("1601") & ChrW("1605") & ChrW("1576") & ChrW("1585") Str12 = ChrW("1583") & ChrW("1610") & ChrW("1587") & ChrW("1605") & ChrW("1576") & ChrW("1585") ElseIf strLng = "En" Then str01 = "January" str02 = "February" str03 = "March" str04 = "April" str05 = "May" str06 = "June" str07 = "July" Str08 = "August" Str09 = "September" Str10 = "October" Str11 = "November" Str12 = "December" ElseIf strLng = "EnShrt" Then str01 = "Jan" str02 = "Feb" str03 = "Mar" str04 = "Apr" str05 = "May" str06 = "Jun" str07 = "Jul" Str08 = "Aug" Str09 = "Sep" Str10 = "Oct" Str11 = "Nov" Str12 = "Dec" ElseIf strLng = "Cpti" Then str01 = ChrW("1591") & ChrW("1608") & ChrW("1576") & ChrW("1577") str02 = ChrW("1571") & ChrW("1605") & ChrW("1588") & ChrW("1610") & ChrW("1585") str03 = ChrW("1576") & ChrW("1585") & ChrW("1605") & ChrW("1607") & ChrW("1575") & ChrW("1578") str04 = ChrW("1576") & ChrW("1585") & ChrW("1605") & ChrW("1608") & ChrW("1583") & ChrW("1577") str05 = ChrW("1576") & ChrW("1588") & ChrW("1606") & ChrW("1587") str06 = ChrW("1576") & ChrW("1572") & ChrW("1608") & ChrW("1606") & ChrW("1577") str07 = ChrW("1571") & ChrW("1576") & ChrW("1610") & ChrW("1576") Str08 = ChrW("1605") & ChrW("1587") & ChrW("1585") & ChrW("1609") Str09 = ChrW("1578") & ChrW("1608") & ChrW("1578") Str10 = ChrW("1576") & ChrW("1575") & ChrW("1576") & ChrW("1577") Str11 = ChrW("1607") & ChrW("1575") & ChrW("1578") & ChrW("1608") & ChrW("1585") Str12 = ChrW("1603") & ChrW("1610") & ChrW("1575") & ChrW("1607") & ChrW("1603") ElseIf strLng = "Syr" Then str01 = ChrW("1603") & ChrW("1575") & ChrW("1606") & ChrW("1608") & ChrW("1606") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1579") & ChrW("1575") & ChrW("1606") & ChrW("1610") str02 = ChrW("1588") & ChrW("1576") & ChrW("1575") & ChrW("1591") str03 = ChrW("1570") & ChrW("1584") & ChrW("1575") & ChrW("1585") str04 = ChrW("1606") & ChrW("1610") & ChrW("1587") & ChrW("1575") & ChrW("1606") str05 = ChrW("1571") & ChrW("1610") & ChrW("1575") & ChrW("1585") str06 = ChrW("1581") & ChrW("1586") & ChrW("1610") & ChrW("1585") & ChrW("1575") & ChrW("1606") str07 = ChrW("1578") & ChrW("1605") & ChrW("1608") & ChrW("1586") Str08 = ChrW("1570") & ChrW("1576") Str09 = ChrW("1571") & ChrW("1610") & ChrW("1604") & ChrW("1608") & ChrW("1604") Str10 = ChrW("1578") & ChrW("1588") & ChrW("1585") & ChrW("1610") & ChrW("1606") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1571") & ChrW("1608") & ChrW("1604") Str11 = ChrW("1578") & ChrW("1588") & ChrW("1585") & ChrW("1610") & ChrW("1606") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1579") & ChrW("1575") & ChrW("1606") & ChrW("1610") Str12 = ChrW("1603") & ChrW("1575") & ChrW("1606") & ChrW("1608") & ChrW("1606") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1571") & ChrW("1608") & ChrW("1604") End If MnthName = Choose(Format(dtAnyDate, "MM"), str01, str02, str03, str04, str05, str06, str07, Str08, Str09, Str10, Str11, Str12) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 5 DayName اسماء الايام - العربى - الانجليزى- اختصار الانجليزى ' .__ __. ___ .___ ___. _______ _______. ______ _______ _______ ___ ____ ____ _______. ' | \ | | / \ | \/ | | ____| / | / __ \ | ____| | \ / \ \ \ / / / | ' | \| | / ^ \ | \ / | | |__ | (----` | | | | | |__ | .--. | / ^ \ \ \/ / | (----` ' | . ` | / /_\ \ | |\/| | | __| \ \ | | | | | __| | | | | / /_\ \ \_ _/ \ \ ' | |\ | / _____ \ | | | | | |____ .----) | | `--' | | | | '--' | / _____ \ | | .----) | ' |__| \__| /__/ \__\ |__| |__| |_______||_______/ \______/ |__| |_______/ /__/ \__\ |__| |_______/ ' Public Function DayName(ByVal dtAnyDate As Date, ByVal strLng As String) 'to call the Function 'To Arabic Day Name 'txtDayNameAR =DayName(txtDate,"Ar") 'To English Day Name 'txtDayNameAR =DayName(txtDate,"En") 'To English Short Day Name 'txtDayNameEnòShrt =DayName(txtDate,"EnShrt") Dim strSat As String Dim strSun As String Dim strMon As String Dim strTues As String Dim strWed As String Dim strThurs As String Dim strFri As String If strLng = "Ar" Then strSat = ChrW("1575") & ChrW("1604") & ChrW("1587") & ChrW("1576") & ChrW("1578") strSun = ChrW("1575") & ChrW("1604") & ChrW("1575") & ChrW("1581") & ChrW("1583") strMon = ChrW("1575") & ChrW("1604") & ChrW("1575") & ChrW("1579") & ChrW("1606") & ChrW("1610") & ChrW("1606") strTues = ChrW("1575") & ChrW("1604") & ChrW("1579") & ChrW("1604") & ChrW("1575") & ChrW("1579") & ChrW("1575") & ChrW("1569") strWed = ChrW("1575") & ChrW("1604") & ChrW("1575") & ChrW("1585") & ChrW("1576") & ChrW("1593") & ChrW("1575") & ChrW("1569") strThurs = ChrW("1575") & ChrW("1604") & ChrW("1582") & ChrW("1605") & ChrW("1610") & ChrW("1587") strFri = ChrW("1575") & ChrW("1604") & ChrW("1580") & ChrW("1605") & ChrW("1593") & ChrW("1577") ElseIf strLng = "En" Then strSat = "Saturday" strSun = "Sunday" strMon = "Monday" strTues = "Tuesday" strWed = "Wednesday" strThurs = "Thursday" strFri = "Friday" ElseIf strLng = "EnShrt" Then strSat = "Sat" strSun = "Sun" strMon = "Mon" strTues = "Tue" strWed = "Wed" strThurs = "Thurs" strFri = "Fri" End If DayName = Choose(Weekday(dtAnyDate), strSun, strMon, strTues, strWed, strThurs, strFri, strSat) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 6 عدد ايام الشهر ' .__ __. __ __ .___ ___. .______ _______ .______ ______ _______ _______ ___ ____ ____ _______. ' | \ | | | | | | | \/ | | _ \ | ____|| _ \ / __ \ | ____| | \ / \ \ \ / / / | ' | \| | | | | | | \ / | | |_) | | |__ | |_) | | | | | | |__ | .--. | / ^ \ \ \/ / | (----` ' | . ` | | | | | | |\/| | | _ < | __| | / | | | | | __| | | | | / /_\ \ \_ _/ \ \ ' | |\ | | `--' | | | | | | |_) | | |____ | |\ \----. | `--' | | | | '--' | / _____ \ | | .----) | ' |__| \__| \______/ |__| |__| |______/ |_______|| _| `._____| \______/ |__| |_______/ /__/ \__\ |__| |_______/ ' ______ _______ _______. _______ __ _______ ______ .___________. _______ _______ .___ ___. ______ .__ __. .___________. __ __ ' / __ \ | ____| / || ____|| | | ____| / || || ____|| \ | \/ | / __ \ | \ | | | || | | | ' | | | | | |__ | (----`| |__ | | | |__ | ,----'`---| |----`| |__ | .--. | | \ / | | | | | | \| | `---| |----`| |__| | ' | | | | | __| \ \ | __| | | | __| | | | | | __| | | | | | |\/| | | | | | | . ` | | | | __ | ' | `--' | | | .----) | | |____ | `----.| |____ | `----. | | | |____ | '--' | | | | | | `--' | | |\ | | | | | | | ' \______/ |__| |_______/ |_______||_______||_______| \______| |__| |_______||_______/ |__| |__| \______/ |__| \__| |__| |__| |__| ' Public Function NumofDays(ByVal dtAnyDate As Date) NumofDays = Day(DateSerial(Year(dtAnyDate), Month(dtAnyDate) + 1, 0)) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 7 تاريخ آخر يوم فى الشهر ' _______ ___ .___________. _______ ______ _______ __ ___ _______..___________. _______ ___ ____ ____ ' | \ / \ | || ____| / __ \ | ____| | | / \ / || | | \ / \ \ \ / / ' | .--. | / ^ \ `---| |----`| |__ | | | | | |__ | | / ^ \ | (----``---| |----` | .--. | / ^ \ \ \/ / ' | | | | / /_\ \ | | | __| | | | | | __| | | / /_\ \ \ \ | | | | | | / /_\ \ \_ _/ ' | '--' | / _____ \ | | | |____ | `--' | | | | `----. / _____ \ .----) | | | | '--' | / _____ \ | | ' |_______/ /__/ \__\ |__| |_______| \______/ |__| |_______|/__/ \__\ |_______/ |__| |_______/ /__/ \__\ |__| ' ______ _______ _______. _______ __ _______ ______ .___________. _______ _______ .___ ___. ______ .__ __. .___________. __ __ ' / __ \ | ____| / || ____|| | | ____| / || || ____|| \ | \/ | / __ \ | \ | | | || | | | ' | | | | | |__ | (----`| |__ | | | |__ | ,----'`---| |----`| |__ | .--. | | \ / | | | | | | \| | `---| |----`| |__| | ' | | | | | __| \ \ | __| | | | __| | | | | | __| | | | | | |\/| | | | | | | . ` | | | | __ | ' | `--' | | | .----) | | |____ | `----.| |____ | `----. | | | |____ | '--' | | | | | | `--' | | |\ | | | | | | | ' \______/ |__| |_______/ |_______||_______||_______| \______| |__| |_______||_______/ |__| |__| \______/ |__| \__| |__| |__| |__| ' Public Function LastDayInMonth(ByVal dtAnyDate As Date) As Date 'to call the Function 'txtLastDayInMonth =LastDayInMonth(txtDate) LastDayInMonth = DateSerial(Year(dtAnyDate), Month(dtAnyDate) + 1, 0) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 8 تاريخ اول يوم فى الشهر Public Function FstDayOfMth(ByVal dtAnyDate As Date) As Date On Error GoTo handleError FstDayOfMth = DateSerial(Year(dtAnyDate), Month(dtAnyDate), 1) GoTo handleSuccess Exit Function handleSuccess: GoTo cleanUp Exit Function handleError: If Err.Number = 94 Then 'createFolder = True Else MsgBox "Error Number : " & Err.Number & vbNewLine & "Error Description : " & Err.Description End If GoTo cleanUp cleanUp: Exit Function End Function الروتين رقم 9 تاريخ اول يوم فى الشهر التالى Public Function FstDayOfNextMnth(ByVal dtAnyDate As Date) As Date FstDayOfNextMnth = DateSerial(Year(dtAnyDate), Month(dtAnyDate) + 1, 1) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 10 تاريخ اول يوم فى الشهر السابق Public Function FstDayPrevMnth(ByVal dtAnyDate As Date) As Date FstDayPrevMnth = DateSerial(Year(dtAnyDate), Month(dtAnyDate) - 1, 1) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 11 تاريخ آخر يوم فى الشهر Public Function LstDayMnth(ByVal dtAnyDate As Date) As Date LstDayMnth = DateSerial(Year(dtAnyDate), Month(dtAnyDate) + 1, 0) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 12 تاريخ آخر يوم فى الشهر التالى Public Function LstDayNextMnth(ByVal dtAnyDate As Date) As Date LstDayNextMnth = DateSerial(Year(dtAnyDate), Month(dtAnyDate) + 2, 0) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 13 تاريخ آخر يوم فى الشهر السابق Public Function LstDayPrevMnth(ByVal dtAnyDate As Date) As Date LstDayPrevMnth = DateSerial(Year(dtAnyDate), Month(dtAnyDate), 0) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 14 ظهور لغة الوقت التى تريدها - عربى - انجلبزى Public Function TimeByLng(ByVal dtAnyDate As Variant, ByVal strLng As String) Dim strAM As String: strAM = ChrW("1589") & ChrW("1576") & ChrW("1575") & ChrW("1581") & ChrW("1575") & ChrW("1611") Dim strPM As String: strPM = ChrW("1605") & ChrW("1587") & ChrW("1575") & ChrW("1569") & ChrW("1611") If strLng = "Ar" Then TimeByLng = MyNo(Replace(Replace(Format(dtAnyDate, "hh:nn:ss AM/PM"), "AM", strAM), "PM", strPM), "ar") ElseIf strLng = "En" Then TimeByLng = MyNo(Replace(Replace(Format(dtAnyDate, "hh:nn:ss AM/PM"), strAM, "AM"), strPM, "PM"), "En") End If End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 15 ظهور لغة الوقت التى تريدها - عربى - انجلبزى Public Function TimeLng(ByVal strLng As String) Dim strAM As String: strAM = ChrW("1589") & ChrW("1576") & ChrW("1575") & ChrW("1581") & ChrW("1575") & ChrW("1611") Dim strPM As String: strPM = ChrW("1605") & ChrW("1587") & ChrW("1575") & ChrW("1569") & ChrW("1611") If strLng = "Ar" Then TimeLng = MyNo(Replace(Replace(Format(Now(), "hh:nn:ss AM/PM"), "AM", strAM), "PM", strPM), "ar") ElseIf strLng = "En" Then TimeLng = MyNo(Replace(Replace(Format(Now(), "hh:nn:ss AM/PM"), strAM, "AM"), strPM, "PM"), "En") End If End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 16 ظهور لغة التاريخ التى تريدها - عربى - انجلبزى Public Function DateByLng(ByVal dtAnyDate As Variant, ByVal strLng As String) If strLng = "Ar" Then DateByLng = MyNo(Format(dtAnyDate, "dd\/mm\/yyyy") & Space(2) & ChrW(1605), "ar") ElseIf strLng = "En" Then DateByLng = MyNo(Format(dtAnyDate, "dd\/mm\/yyyy") & Space(2) & ChrW(1605), "En") End If End Function '----------------------------End------------------------------------------------------------------------------------------- يتبع .... DateFunctions.zip
  11. السلام عليكم ورحمة اله تعالى وبركاته انا بصدد تحديث لاحد قواعد البيانات قمت بتصميمها منذ ما يقارب 6 سنوات وان شاء الله سوف يكون هذا اول تحديث لى عليها وبأمر الله تباعا سوف اضع بين اياديكم درر وخلاصة افكارى اولا : اعتذر فى الفترة المقبلة عن التقصير فى الرد على التساؤلات لضيق وقتى ثانيا : ان شاء الله اقوم بالبناء خطوة بعد خطوة ومشاركتكم لعملى ----------------- بسم الله الرحمن الرحيم على بركة الله اولا سوف يتم مراعاة ان تعمل قاعدة البيانات على كلا النواتان X32 , x64 قاعدة البيانات سوف تكون مقسمة لقاعدتان اماية وخلفية المشكلة الأولى : عدم اتصال الجهاز الكلينت بجهاز السرفر الذى يحوى قاعدة البيانات واحضار الوقت والتاريخ من جهاز السرفر سوف ابدأ بكود جلب الوقت والتاريخ من جهاز السيرفر لاستاذى الجليل و معلمى القدير و والدى الحبيب الاستاذ @jjafferr ولكن مع بعض الاضافات التى سوف تندمج بها بعد ذلك مع كود عمل الاكسس والربط بجهاز السرفر اولا فى رأس الموديول يتم الاعلان عن متغير عام Public GetsrvDate As Date بعد ذلك نقوم بعمل الروتين الاتى Public Function srvDate() srvDate = Nz(GetsrvDate, Null) End Function الروتين السابق لكى نستطيع استخدامة فى زوايا التطبيق اينما نريد سوف نسند اليه القيمة التى يحملها المتغير العام الذى قمنا بتعريفه فى رأس الموديول الروتين الاتى جلب الوقت والتاريخ من جهاز السرفر لاستاذى الجليل و معلمى القدير و والدى الحبيب الاستاذ @jjafferr 'call By >>---> Me.srvr_Date_Time = Make_File3(Me.srvr_Domain_Name) Public Function Make_File3(BE_Path As String) On Error GoTo err_Make_File3 Dim PauseTime, Start 'we need the path to have a slash at its end If Right(BE_Path, 1) <> "\" Then BE_Path = BE_Path & "\" End If BE_Path = BE_Path & "dummy.txt" 'make the dummy txt file Open BE_Path For Output As #1 Print #1, "No text required" Close #1 'pasue for a second, until file is recognized, for slow networks PauseTime = 1 ' Set duration. Start = Timer ' Set start time. Do While Timer < Start + PauseTime DoEvents ' Yield to other processes. Loop 'get the date created Make_File3 = FileDateTime(BE_Path) 'clean up, delete the file Kill BE_Path Exit_Make_File3: Exit Function err_Make_File3: If Err.Number = 75 Then MsgBox "Access Denied" & vbCrLf & "You do not have permission to write to the folder" ElseIf Err.Number = 53 Then Make_File3 = FileDateTime(BE_Path) Kill BE_Path BE_Path = vbNullString Make_File3 = vbNullString Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If Resume Exit_Make_File3 End Function بعد ذلك روتين الاتصال بالسرفر من خلال الاكسس Public Function AccessToSrv(ByVal ServerShare As String, ByVal UserName As String, ByVal Password As String, ByRef OpenFrmSplash As String) On Error GoTo Proc_Err Dim FSO As Object Dim Directory As Object Dim Filename As Object Dim NetworkObject As Object Set NetworkObject = CreateObject("WScript.Network") Set FSO = CreateObject("Scripting.FileSystemObject") NetworkObject.MapNetworkDrive "", ServerShare, False, UserName, Password Set Directory = FSO.GetFolder(ServerShare) For Each Filename In Directory.Files 'Debug.Print Filename.Name Next 'Shell "cmd.exe /c start """" """ & ServerShare & """" ', vbNormalFocus 'Shell "C:\WINDOWS\explorer.exe """ & ServerShare & "", vbNormalFocus AccessToSrv = Make_File3(ServerShare) GetsrvDate = AccessToSrv DoCmd.Close DoCmd.OpenForm OpenFrmSplash Set Filename = Nothing Set Directory = Nothing Set FSO = Nothing NetworkObject.RemoveNetworkDrive ServerShare, True, False Set NetworkObject = Nothing Proc_Exit: Exit Function Proc_Err: Resume Proc_Exit Resume End Function يتم وضع الكود الاتى لبدأ روتين الاتصال بالشبكة فى العمل مع مراعاة الاتى 1- التأكد من عمل مشاركة لمجلد على جهاز السرفر والذى بدوره سوف يحتوى على قاعدة بيانات الخلفية 2- التأكد من بيانات الاتصال لعمل اكسس على جهاز السرفر كود الاتصال يتم وضعه على زر امر كالاتى Call AccessToSrv(Me.txtShardFolderPathe, Me.txtUserName, Me.txtPassWord, "frmMain") حيث أن txtShardFolderPathe= مسار مجلد المشاركة كاملا مثل \\192.168.1.3\DBSharing txtUserName = اسم المستخدم لفتح جهاز السرفر txtPassWord= كلمة مرور الولوج لجهاز السرفر "frmMain" = اسم النموذج الذى نريد لقاعدة البيانات فتحة بعد الولوج للسيرفر من هلال النموذج المعد لذلك ولو اردنا التعامل مع التاريخ الذى تم جلبه من السرفر من خلال call srvDate اترككم مع الاستمتاع بالمرفق LoginServer.accdb
  12. السلام عليكم ورحمة الله تعالى وبركاته قائمة ديناميكية طى وتوسيع لهواة تصميم واجهات مودرن اترككم مع التجربــة collapse menu.zip
  13. Version 4.0.3 بدعم مكتبات جافا

    385 تنزيل

    تم التعديل ليتناسب مع نسخ الاوفيس بدأ من 2007 وحتى 2021 للنوتان 32 , 64 التطبيق اهداء الى منتدانا الحبيب ورواد المنتدى العمل حتى يخرج بهذه الصورة يعلم الله وحده الجهد المبذول به اسال الله تعالى ان يتقبل هذا العمل صدقة جارية الى ما شاء الله تعالى ms access becomes an authorized e-invoicing solution provider in Saudi Arabia by www.officena.net Start your e-invoicing journey حسب متطلبات هيئة الزكاة والضريبة والجمارك السعودية يتم قراءة الرمز الناتج ان شاء الله عبر القارىء الرسمي الخاص بالهيئة ( تطبيق جوال ) حمل من هنا : التطبيق الرسمي لهيئة الزكاة والضريبة والجمارك يتم قراءة الرمز الناتج ان شاء الله عبر قارىء خاص ( تطبيق جوال ) حمل من هنا : تطبيق قرائة رمز الاستجابة طبقات لمتطلبات هيئة الزكاة والضريبة والجمارك متطلبات التشغيل : Framework الاصدار 4 ------------------------------------------------------------------------------- يمكن تحميل الملف الاتى هو يقوم بالتحديثات اللازمة سواء ويندوز 7 , 10 , 11 إذهب الى موقع التحميل : من هنا ( تحميل مباشر من mediafire .. من رفعي انا على حسابي الشخصي بالموقع ) ميزات برنامج All in one Runtimes: سهل الاستخدام و مفيد للغاية في تقليل الزمن الضروري للبحث عن الأدوات كلٍ على حدا. مجاني بشكل كامل و يقدم الكثير من الفائدة و يمكنه حمايتك من المواقع التي قد تصيب جهازك بفيروسات سيئة عند التحميل منها. يعمل بشكل ذكي حيث يقوم بتحديد ما يحتاجه حاسبك و لن يقوم بتثبيت كل الأدوات بشكل عشوائي. يقدم مجموعة كبيرة من الأدوات الضرورية في حاسبك و أهمها: .NET Framework 4.6 + Updates Java Runtime Environment 8 DirectX 9.0c Extra files General runtime files Microsoft Visual C++ Runtimes (v2005 – v2015) Microsoft Visual J# 2.0 SE Microsoft Silverlight 5 Shockwave Player 12 (Internet Explorer Plugin) ------------------------------------------------------------------------------- الجديد فى هذا الموضوع وسبب تطوير تلك القاعدة . نظرا للمشاكل التي واجهت أحبابي سابقا بسبب تسجيل الملفات .. تم بفضل الله تعالى حل كل المشاكل تقريبا لن نحتاج الى نقل مجلد ملفات مكتبات الـ DLL الى أي مكان يتم إنشاء المجلد اليا بنفس مسار القاعدة يتم تحميل الملفات من قاعدة البيانات اليا تشغيل ملف التسجيل Register.bat اليا.. عند فتح القاعدة للمرة الأولى ومحاولة انشاء رمز الـ Qr وفى حالة عدم تسجيل مكتبة الجافا يتم اغلاق القاعدة اليا وفتح ملف التسجيل كمسؤول نظام دون أي تدخل من المستخدم نهائيا مميزات القاعدة الحفاظ على الملفات الهامة بحملها داخل القاعدة وتحميلها لمسار القاعدة فى كل مرة يتم فيها فتح القاعدة شغيل ملف التسجيل Register.bat اليا عند الحاجة لذلك يدعم النواتان 64 , 32 تشفير البيانات طبقا لمتطلبات هيئة الزكاة والضريبة والجمارك السعودية الاحتفاظ بالبيانات المشفرة لكل سجل حجم الصورة الخاصة برمز الاستجابة السريع QR CODE صغير جدا لمن يريد الاحتفاظ بهم لكل سجل أتمنى لكم تجربة ممتعة ... الفائدة من تصميى المتواضع وافكارى والمميزات حمل ملفاتى الهامة داخل القاعدة وبذلك لن يتم فقدانها مطلقا لاى سبب الا بفقد القاعدة نفسها عند نقل القاعدة لاى جهاز يتم وضع الملفات بتحميلها من القاعدة الى الجهاز اليا فى مسار القاعدة فلن يشغل بال المستخدم اى شئ بخصوص ملفات المكتبات عند عدم تسجيل المكتبات يتم ذلك اليا دون ادنى تدخل من المستخدم يتم فتح الملف الدفعى اليا فى حالة عدم تسجيل المكتبات وهو يعيد تشغيل نفسه كمسؤل ويقوم باللازم عند الانتها للملف الدفعى من التسجيل للمكتبات يعيد فتح القاعدة اليا واغلاق نفسه وجب التنويه لبعض النقاط لمن يريد نقل الافكار الى عمله مراعاة والاخذ فى الاعتبار عند محاولة تغيير اسم القاعدة ان اردتم لابد من تغيره كذلك بنفس الاسم الجديد فى الملف الدفعى حيث انه يقوم بفتح القاعدة اليا بعد التسجيل مراعاة الاخذ فى الاعتبار عند محاولة تغيير اسم النموذج frmElcInvoicing تغير الاسم كذلك فى نموذج البدأ UsysfrmInsertAllObjects الحرص على وجود الجدول UsystblBlob و الموديول UsysmodBlob والنموذج UsysfrmInsertAllObjects لانهم المختصون بحمل ملفات المكتبات داخل القاعدة وتحميلها وتسجيلها بشكل آلى بالهناء لكم وبالتوفيق للحميع ان شاء الله
  14. السلام عليكم ورحمة الله تعالى وبركاته اعلم اننى قمت بعمل شبيه لذلك من قبل ولكن تم اختزال الاكواد بشكل كبير جدا جدا جدا جدا عن ذى قبل مع الأخذ فى الاعتبار مرونة تعاطى وتعامل التطبيق مع الاكواد عن ذى قبل مع اضافة افكار جديدة تماما.. فى انتظار رأيكم بعد التجربة .. ورجاء وضع الافكار المستقبلية والتى تحبون أن يكتمل العمل بها OfficenaAudioPlayer.mdb
  15. الغاء وتمكين عمل زر الـ Shift يتناسب مع جميع تنسيقات قواعد البيانات ولو كانت قواعد البيانات المحمية بكلمة مرور المرفق يتناسب مع كلتا النواتان 32 , 64 Bit تمكين الشفت.mdb
  16. السلام عليكم ورحمة الله وبركاته احيانا تحدث مشكلات عند تنفيذ احد الاجراءات تبعا للكود المستخدم فكرتى المتواضعة فى هذا المرفق 1- تسجيل الاخطاء ليقف المصمم , المطور , المبرمج على مكان الخطأ تحديدا ورقمه لسهولة حل المشكلة 2- تجاوز الاخطاء كما يترائى لـ المصمم , المطور , المبرمج من خلال الأخطاء التى تم تصيدها وتسجيلها بالجدول Write Error Log .mdb
  17. اعرض الملف ksa e-invoicing تم التعديل ليتناسب مع نسخ الاوفيس بدأ من 2007 وحتى 2021 للنوتان 32 , 64 التطبيق اهداء الى منتدانا الحبيب ورواد المنتدى ولكن اشهد الله تعالى ان هذا العمل مقدم لكل من يريده مجانا وعلى سبيل الهدية لوجه الله تعالى ولا اسمح نهائيا ببيعه اللهم انى بلغت اللهم فاشهد العمل حتى يخرج بهذه الصورة يعلم الله وحده الجهد المبذول به اسال الله تعالى ان يتقبل هذا العمل صدقة جارية الى ما شاء الله تعالى ms access becomes an authorized e-invoicing solution provider in Saudi Arabia by www.officena.net Start your e-invoicing journey حسب متطلبات هيئة الزكاة والضريبة والجمارك السعودية يتم قراءة الرمز الناتج ان شاء الله عبر القارىء الرسمي الخاص بالهيئة ( تطبيق جوال ) حمل من هنا : التطبيق الرسمي لهيئة الزكاة والضريبة والجمارك يتم قراءة الرمز الناتج ان شاء الله عبر قارىء خاص ( تطبيق جوال ) حمل من هنا : تطبيق قرائة رمز الاستجابة طبقات لمتطلبات هيئة الزكاة والضريبة والجمارك متطلبات التشغيل : Framework الاصدار 4 ------------------------------------------------------------------------------- يمكن تحميل الملف الاتى هو يقوم بالتحديثات اللازمة سواء ويندوز 7 , 10 , 11 إذهب الى موقع التحميل : من هنا ( تحميل مباشر من mediafire .. من رفعي انا على حسابي الشخصي بالموقع ) ميزات برنامج All in one Runtimes: سهل الاستخدام و مفيد للغاية في تقليل الزمن الضروري للبحث عن الأدوات كلٍ على حدا. مجاني بشكل كامل و يقدم الكثير من الفائدة و يمكنه حمايتك من المواقع التي قد تصيب جهازك بفيروسات سيئة عند التحميل منها. يعمل بشكل ذكي حيث يقوم بتحديد ما يحتاجه حاسبك و لن يقوم بتثبيت كل الأدوات بشكل عشوائي. يقدم مجموعة كبيرة من الأدوات الضرورية في حاسبك و أهمها: .NET Framework 4.6 + Updates Java Runtime Environment 8 DirectX 9.0c Extra files General runtime files Microsoft Visual C++ Runtimes (v2005 – v2015) Microsoft Visual J# 2.0 SE Microsoft Silverlight 5 Shockwave Player 12 (Internet Explorer Plugin) ------------------------------------------------------------------------------- الجديد فى هذا الموضوع وسبب تطوير تلك القاعدة . نظرا للمشاكل التي واجهت أحبابي سابقا بسبب تسجيل الملفات .. تم بفضل الله تعالى حل كل المشاكل تقريبا لن نحتاج الى نقل مجلد ملفات مكتبات الـ DLL الى أي مكان يتم إنشاء المجلد اليا بنفس مسار القاعدة يتم تحميل الملفات من قاعدة البيانات اليا تشغيل ملف التسجيل Register.bat اليا.. عند فتح القاعدة للمرة الأولى ومحاولة انشاء رمز الـ Qr وفى حالة عدم تسجيل مكتبة الجافا يتم اغلاق القاعدة اليا وفتح ملف التسجيل كمسؤول نظام دون أي تدخل من المستخدم نهائيا مميزات القاعدة الحفاظ على الملفات الهامة بحملها داخل القاعدة وتحميلها لمسار القاعدة فى كل مرة يتم فيها فتح القاعدة شغيل ملف التسجيل Register.bat اليا عند الحاجة لذلك يدعم النواتان 64 , 32 تشفير البيانات طبقا لمتطلبات هيئة الزكاة والضريبة والجمارك السعودية الاحتفاظ بالبيانات المشفرة لكل سجل حجم الصورة الخاصة برمز الاستجابة السريع QR CODE صغير جدا لمن يريد الاحتفاظ بهم لكل سجل أتمنى لكم تجربة ممتعة ... الفائدة من تصميى المتواضع وافكارى والمميزات حمل ملفاتى الهامة داخل القاعدة وبذلك لن يتم فقدانها مطلقا لاى سبب الا بفقد القاعدة نفسها عند نقل القاعدة لاى جهاز يتم وضع الملفات بتحميلها من القاعدة الى الجهاز اليا فى مسار القاعدة فلن يشغل بال المستخدم اى شئ بخصوص ملفات المكتبات عند عدم تسجيل المكتبات يتم ذلك اليا دون ادنى تدخل من المستخدم يتم فتح الملف الدفعى اليا فى حالة عدم تسجيل المكتبات وهو يعيد تشغيل نفسه كمسؤل ويقوم باللازم عند الانتها للملف الدفعى من التسجيل للمكتبات يعيد فتح القاعدة اليا واغلاق نفسه وجب التنويه لبعض النقاط لمن يريد نقل الافكار الى عمله مراعاة والاخذ فى الاعتبار عند محاولة تغيير اسم القاعدة ان اردتم لابد من تغيره كذلك بنفس الاسم الجديد فى الملف الدفعى حيث انه يقوم بفتح القاعدة اليا بعد التسجيل مراعاة الاخذ فى الاعتبار عند محاولة تغيير اسم النموذج frmElcInvoicing تغير الاسم كذلك فى نموذج البدأ UsysfrmInsertAllObjects الحرص على وجود الجدول UsystblBlob و الموديول UsysmodBlob والنموذج UsysfrmInsertAllObjects لانهم المختصون بحمل ملفات المكتبات داخل القاعدة وتحميلها وتسجيلها بشكل آلى بالهناء لكم وبالتوفيق للحميع ان شاء الله صاحب الملف ابو جودي تمت الاضافه 20 ديس, 2021 الاقسام قسم الأكسيس  
  18. السلام عليكم ورحمة الله تعالى وبركاته الجواب يعرف من العنوان واترككم مع التجربة ـــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ SmartSort.accdb
  19. التلميح داخل مربع النص مع علامة مائية فى حالة كان مربع النص فارغ ويختفيان بمجرد التركيز داخل مربه النص او الكتابة ... ToolTip.mdb
  20. شفافيــــــــــــTransparent Formsــــــــــــة النماذج Transparent Forms.mdb
×
×
  • اضف...

Important Information