SEMO.Pa3x

ارفق قاعدة بياناتك لكي نتمكن من مساعدتك.

عليكم السلام Public Function getMessage(msgID As Integer) 'define vars Dim vMessage, vTitle As String 'return values vMessage = DLookup("txtMessageText", "tblMessages", "txtAutoIntMessageID =" & msgID) vTitle = DLookup("txtMessageText", "tblMessages", "txtAutoIntMessageID =" & msgID) 'return values getMessage = vMessage & "||" & vTitle End Function الدالة سوف تقوم بإرجاع قيمة تتضمن الرسالة والعنوان وبين الرسالة والعنوان علامة || لكي تقوم بعمل Split وفصلهم بالشكل الآتي: 'define vars Dim splitMessage(), gMessage, gTitle As String 'replace YOUR_MSG_ID with your id splitMessage = Split(getMessage(YOUR_MSG_ID), "||") 'get results gMessage = splitMessage(0) 'get Message gTitle = splitMessage(1) 'get Title

ارفق قاعدة بياناتك لكي نتمكن من مساعدتك.

الطريقة تفيد في ما اذا كان هدفك هو عرض البيانات فقط اما اذا اردت عرض البيانات وعند الضغط على اي سجل يظهر لك خيارات كـ تعديل او حذف او غيرها او مثلا لديك تصميم نموذج يختلف عن الثاني، فإنها تكون طريقة عاجزة تماماً أو مثلا اذا اردت ان تنادي حقول معينة يتوجب عليك بناء استعلام لكل جدول. لذلك اختصر الوقت من البداية، وقم بعمل نماذج فرعية أفضل.

طبق نفس الكلام، بالنسبة لباقي التبويبات بالنموذج. 1390.nabil2322.accdb

اخي انضر الى الصورة جيدا، انت في تبويب تنسيق بينما خيارات السجلات في تبويب الكل

عليكم السلام.. اجعلهم = لا

معلومة جديدة تضاف الى رصيدي المعرفي، وهي المثلث الاخضر. جزيل الشكر لك

تفضل: If DCount("[npart]", "part", "cpart=" & aa) > 0 Then MsgBox "Exist !" Else MsgBox "Not Exists" End If

حسب علمي اجهزة الباركود لا تقرأ اللغة العربية

عليكم السلام، اخي وضح طلبك بالضبط نحن لا نعمل بالتكهنات

عليكم السلام، لا اضن ان بإمكانك استخدام دالة SumProduct الخاصة بالأكسيل داخل الأكسيس يمكنك استخدام RecordSet لمحاكاة عمل الدالة وكتابتة دالة تؤدي نفس الوظيفة.

عليكم السلام، نعم يمكن ذلك فهو بديل للـ Listview لكن ليست جميع التنسيقات متوفرة لايمكنك توسيط النص اما غيره نعم يمكن ذلك يمكن وضع اعمدة وعند الضغط على اي row يظهر لك فورم لتعديل البيانات

نعم

استخدم تقنية Regex الباترن: ^\d+(\/\d+)*$ Option Compare Database Option Explicit Private Sub txt_number_AfterUpdate() If RegexMatch(txt_number, "^\d+(\/\d+)*$") = True Then MsgBox "عملية ناجحة" Else MsgBox "عملية خاطئة، الحقل يتضمن نصوص" End If End Sub ' ----------------------------------------------------------------------' ' Return True if the given string value matches the given Regex pattern ' ' ----------------------------------------------------------------------' Public Function RegexMatch(value As Variant, pattern As String) As Boolean If IsNull(value) Then Exit Function ' Using a static, we avoid re-creating the same regex object for every call ' Static regex As Object ' Initialise the Regex object ' If regex Is Nothing Then Set regex = CreateObject("vbscript.regexp") With regex .Global = True .IgnoreCase = True .MultiLine = True End With End If ' Update the regex pattern if it has changed since last time we were called ' If regex.pattern <> pattern Then regex.pattern = pattern ' Test the value against the pattern ' RegexMatch = regex.test(value) End Function

عليكم السلام، ارفق قاعدة بياناتك لكي نتمكن من مساعدتك

عليكم السلام، وضح طلبك بصورة أبسط لكي نتمكن من مساعدتك.

عليكم السلام.. انا لم اجرب ربط الأكسس اون لاين بمؤسسة او شركة او غيره لكن اذا كانت تلك المؤسسة وفرت لك Web API سيمكنك ذلك من قراءة وارسال البيانات عبر الـ HTTP REQUEST وصراحة انا لا ارى الأكسس جدير بهذا الشي الأفضل لك ان تنتقل لبيئة الـ Visual Studio .NET ففيها الآف الطرق والمكتبات لهذا الغرض.

لا حاجة لـ AscW دعنا نستخدم الفنكشنات التي تم طرحها في موضوع الترجمة هنا: 'فنكشن فك التشفير Function DecodeQP2(s As String) As String Dim i As Long Dim p1 As Long Dim p2 As Long Dim r As String i = 2 Do While i < Len(s) Select Case Mid(s, i, 1) Case "0" To "7" r = r & Chr(CLng("&H" & Mid(s, i, 2))) Case "C", "D" p1 = CLng("&H" & Mid(s, i, 2)) - 192 i = i + 3 p2 = CLng("&H" & Mid(s, i, 2)) - 128 r = r & ChrW(64 * p1 + p2) Case Else ' Not handled End Select i = i + 3 Loop DecodeQP2 = r End Function 'فنكشن التشفير Function EncodeQP2(s As String) As String Dim i As Long Dim p1 As Long Dim p2 As Long Dim r As String Dim n As Long For i = 1 To Len(s) n = AscW(Mid(s, i, 1)) If n < 128 Then r = r & "%" & Hex(n) ElseIf n < 2048 Then p1 = n \ 64 r = r & "%" & Hex(p1 + 192) p2 = n Mod 64 r = r & "%" & Hex(p2 + 128) Else End If Next i EncodeQP2 = r End Function الـ Module في الأكسس: Option Compare Database Option Explicit '-------------------------------------------------------- 'c0ded bY : SEMO.Pa3x 'telegram : semo_pa4x 'facebook : https://www.facebook.com/Nisr.Aln3jaf 'last edit : 26/4/2019 '-------------------------------------------------------- Private Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDescriptor As Long bInheritHandle As Long End Type Private Type PROCESS_INFORMATION hProcess As Long hThread As Long dwProcessId As Long dwThreadId As Long End Type Private Type STARTUPINFO cb As Long lpReserved As Long lpDesktop As Long lpTitle As Long dwX As Long dwY As Long dwXSize As Long dwYSize As Long dwXCountChars As Long dwYCountChars As Long dwFillAttribute As Long dwFlags As Long wShowWindow As Integer cbReserved2 As Integer lpReserved2 As Byte hStdInput As Long hStdOutput As Long hStdError As Long End Type Private Const WAIT_INFINITE As Long = (-1&) Private Const STARTF_USESHOWWINDOW As Long = &H1 Private Const STARTF_USESTDHANDLES As Long = &H100 Private Const SW_HIDE As Long = 0& Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long Private Declare Sub GetStartupInfo Lib "kernel32" Alias "GetStartupInfoA" (lpStartupInfo As STARTUPINFO) Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long Private Function Redirect(szBinaryPath As String, szCommandLn As String) As String Dim tSA_CreatePipe As SECURITY_ATTRIBUTES Dim tSA_CreateProcessPrc As SECURITY_ATTRIBUTES Dim tSA_CreateProcessThrd As SECURITY_ATTRIBUTES Dim tSA_CreateProcessPrcInfo As PROCESS_INFORMATION Dim tStartupInfo As STARTUPINFO Dim hRead As Long Dim hWrite As Long Dim bRead As Long Dim abytBuff() As Byte Dim lngResult As Long Dim szFullCommand As String Dim lngExitCode As Long Dim lngSizeOf As Long tSA_CreatePipe.nLength = Len(tSA_CreatePipe) tSA_CreatePipe.lpSecurityDescriptor = 0& tSA_CreatePipe.bInheritHandle = True tSA_CreateProcessPrc.nLength = Len(tSA_CreateProcessPrc) tSA_CreateProcessThrd.nLength = Len(tSA_CreateProcessThrd) If (CreatePipe(hRead, hWrite, tSA_CreatePipe, 0&) <> 0&) Then tStartupInfo.cb = Len(tStartupInfo) GetStartupInfo tStartupInfo With tStartupInfo .hStdOutput = hWrite .hStdError = hWrite .dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES .wShowWindow = SW_HIDE End With szFullCommand = """" & szBinaryPath & """" & " " & szCommandLn lngResult = CreateProcess(0&, szFullCommand, tSA_CreateProcessPrc, tSA_CreateProcessThrd, True, 0&, 0&, vbNullString, tStartupInfo, tSA_CreateProcessPrcInfo) If (lngResult <> 0&) Then lngResult = WaitForSingleObject(tSA_CreateProcessPrcInfo.hProcess, WAIT_INFINITE) lngSizeOf = GetFileSize(hRead, 0&) If (lngSizeOf > 0) Then ReDim abytBuff(lngSizeOf - 1) If ReadFile(hRead, abytBuff(0), UBound(abytBuff) + 1, bRead, ByVal 0&) Then Redirect = StrConv(abytBuff, vbUnicode) End If End If Call GetExitCodeProcess(tSA_CreateProcessPrcInfo.hProcess, lngExitCode) CloseHandle tSA_CreateProcessPrcInfo.hThread CloseHandle tSA_CreateProcessPrcInfo.hProcess If (lngExitCode <> 0&) Then Err.Raise vbObject + 1235&, "GetExitCodeProcess", "Non-zero Application exist code" CloseHandle hWrite CloseHandle hRead Else Err.Raise vbObject + 1236&, "CreateProcess", "CreateProcess Failed, Code: " & Err.LastDllError End If End If End Function Public Function MainRedirect(param As String) Dim resp As String resp = Redirect(CurrentProject.Path & "\" & "app.exe", EncodeQP2(param)) MainRedirect = DecodeQP2(resp) End Function Function DecodeQP2(s As String) As String Dim i As Long Dim p1 As Long Dim p2 As Long Dim r As String i = 2 Do While i < Len(s) Select Case Mid(s, i, 1) Case "0" To "7" r = r & Chr(CLng("&H" & Mid(s, i, 2))) Case "C", "D" p1 = CLng("&H" & Mid(s, i, 2)) - 192 i = i + 3 p2 = CLng("&H" & Mid(s, i, 2)) - 128 r = r & ChrW(64 * p1 + p2) Case Else ' Not handled End Select i = i + 3 Loop DecodeQP2 = r End Function Function EncodeQP2(s As String) As String Dim i As Long Dim p1 As Long Dim p2 As Long Dim r As String Dim n As Long For i = 1 To Len(s) n = AscW(Mid(s, i, 1)) If n < 128 Then r = r & "%" & Hex(n) ElseIf n < 2048 Then p1 = n \ 64 r = r & "%" & Hex(p1 + 192) p2 = n Mod 64 r = r & "%" & Hex(p2 + 128) Else End If Next i EncodeQP2 = r End Function الإستدعاء: Private Sub cmd_send_Click() MsgBox MainRedirect("السلام عليكم") End Sub لاحظ ان النص تم تشفيره وفكه في الـ Module وليس في الإستدعاء.. التطبيق المساعد بلغة NET. Module Module1 Sub Main() For Each arg As String In My.Application.CommandLineArgs Select Case DecodeQP2(arg) Case "السلام عليكم" Console.WriteLine(EncodeQP2("عليكم السلام ورحمة الله وبركاته")) Case "كيف حالك" Console.WriteLine(EncodeQP2("الحمدلله")) Case Else Console.WriteLine(EncodeQP2("لم تقم بإرسال سؤال")) End Select Next End Sub Function DecodeQP2(s As String) As String Dim i As Long Dim p1 As Long Dim p2 As Long Dim r As String i = 2 Do While i < Len(s) Select Case Mid(s, i, 1) Case "0" To "7" r = r & Chr(CLng("&H" & Mid(s, i, 2))) Case "C", "D" p1 = CLng("&H" & Mid(s, i, 2)) - 192 i = i + 3 p2 = CLng("&H" & Mid(s, i, 2)) - 128 r = r & ChrW(64 * p1 + p2) Case Else ' Not handled End Select i = i + 3 Loop DecodeQP2 = r End Function Function EncodeQP2(s As String) As String Dim i As Long Dim p1 As Long Dim p2 As Long Dim r As String Dim n As Long For i = 1 To Len(s) n = AscW(Mid(s, i, 1)) If n < 128 Then r = r & "%" & Hex(n) ElseIf n < 2048 Then p1 = n \ 64 r = r & "%" & Hex(p1 + 192) p2 = n Mod 64 r = r & "%" & Hex(p2 + 128) Else End If Next i EncodeQP2 = r End Function End Module النتيجة: تغلبنا على مشكلة اللغة العربية في الكونسول.. ملاحظة مهمة: أغلق الأنتي فايروس قبل التجربة لإن الدالة ( CreateProcessA ) يصنفها الأنتي فايروس كدالة مشبوهة لإنها تقوم بإنشاء عملية في النظام لمن يريد التجربة ارفقت لكم ملفات المشروع كاملة.. تحياتي لكم.. app.rar

حسناً، سأجيب على الأسئلة قدر استطاعتي وسيكون الشرح على Visual Studio .NET الـ SDK هو عبارة عن reference يتم اضافته لمشروع الـ NET. على هيئة ملف dll. كيف نقوم بإضافته لمشروعنا ؟ وسيصبح بجانب البرنامج عند عمل Compile أي إن البرنامج لن يعمل بدون هذه المكتبة. وهذه المكتبات التي قلنا انها ملفات dll. تكون مكتوبة حصراً بلغة NET. وهي عبارة عن classes / modules تمرر لها مدخلاتك تقوم هية بالفلترة وتعطيك المخرجات وانت بدورك ستقوم بإستقبالها بحسب اللغة المقابلة. حسناً، عمل الوسيط وإرسال المعلومات له ليس بالشيء الصعب لكن الصعب هو استلام البيانات من الوسيط.. أولا: نقوم بعمل الوسيط... سنقوم بعمل تطبيق وظيفته نرسل له عبارة معينة فيرد علينا بعبارة أخرى بلغة NET. Module Module1 Sub Main() For Each arg As String In My.Application.CommandLineArgs Select Case arg Case "hi" Console.WriteLine("Hi, How are you !") Case "how old are you" Console.WriteLine("i'm 25 years old") Case Else Console.WriteLine("ask me !") End Select Next End Sub End Module لاحظ الحلقة Select Case اذا قلنا Hi يجيبنا Hi, How are you ..الخ من باقي التخمينات في الحلقة. السطر الأهم هو Console.WriteLine هو سيقوم بكتابة الإجابة على الكونسول وسنقوم بقراءتها المشكلة ان الكونسول ( cmd.exe ) لا يدعم اللغة العربية ! ممكن نقوم بحل المشكلة بإستبدال الحروف العربية بإنكليزية مثال ( A = أ ) وسنقوم بالأكسس باستبدال الأنكليزي بالعربي وارجاع الحروف لإصلها اضن ان الفكرة وصلت.. ------------------------------------------------------------------------------------------- الآن مرحلة ارسال وإستقبال البيانات في الأكسس والطريقة الأفضل هي Windows API والدوال المطلوبة هي: CreatePipe CreateProcessA ReadFile CloseHandle WaitForSingleObject GetExitCodeProcess GetStartupInfo GetFileSize لتفاصيل أكثر، اضغط على إسم الدالة أرفقت لكم مصادر من MSDN Option Compare Database Option Explicit '-------------------------------------------------------- 'c0ded bY : SEMO.Pa3x 'telegram : semo_pa4x 'facebook : https://www.facebook.com/Nisr.Aln3jaf 'last edit : 26/4/2019 '-------------------------------------------------------- Private Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDescriptor As Long bInheritHandle As Long End Type Private Type PROCESS_INFORMATION hProcess As Long hThread As Long dwProcessId As Long dwThreadId As Long End Type Private Type STARTUPINFO cb As Long lpReserved As Long lpDesktop As Long lpTitle As Long dwX As Long dwY As Long dwXSize As Long dwYSize As Long dwXCountChars As Long dwYCountChars As Long dwFillAttribute As Long dwFlags As Long wShowWindow As Integer cbReserved2 As Integer lpReserved2 As Byte hStdInput As Long hStdOutput As Long hStdError As Long End Type Private Const WAIT_INFINITE As Long = (-1&) Private Const STARTF_USESHOWWINDOW As Long = &H1 Private Const STARTF_USESTDHANDLES As Long = &H100 Private Const SW_HIDE As Long = 0& Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long Private Declare Sub GetStartupInfo Lib "kernel32" Alias "GetStartupInfoA" (lpStartupInfo As STARTUPINFO) Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long Private Function Redirect(szBinaryPath As String, szCommandLn As String) As String Dim tSA_CreatePipe As SECURITY_ATTRIBUTES Dim tSA_CreateProcessPrc As SECURITY_ATTRIBUTES Dim tSA_CreateProcessThrd As SECURITY_ATTRIBUTES Dim tSA_CreateProcessPrcInfo As PROCESS_INFORMATION Dim tStartupInfo As STARTUPINFO Dim hRead As Long Dim hWrite As Long Dim bRead As Long Dim abytBuff() As Byte Dim lngResult As Long Dim szFullCommand As String Dim lngExitCode As Long Dim lngSizeOf As Long tSA_CreatePipe.nLength = Len(tSA_CreatePipe) tSA_CreatePipe.lpSecurityDescriptor = 0& tSA_CreatePipe.bInheritHandle = True tSA_CreateProcessPrc.nLength = Len(tSA_CreateProcessPrc) tSA_CreateProcessThrd.nLength = Len(tSA_CreateProcessThrd) If (CreatePipe(hRead, hWrite, tSA_CreatePipe, 0&) <> 0&) Then tStartupInfo.cb = Len(tStartupInfo) GetStartupInfo tStartupInfo With tStartupInfo .hStdOutput = hWrite .hStdError = hWrite .dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES .wShowWindow = SW_HIDE End With szFullCommand = """" & szBinaryPath & """" & " " & szCommandLn lngResult = CreateProcess(0&, szFullCommand, tSA_CreateProcessPrc, tSA_CreateProcessThrd, True, 0&, 0&, vbNullString, tStartupInfo, tSA_CreateProcessPrcInfo) If (lngResult <> 0&) Then lngResult = WaitForSingleObject(tSA_CreateProcessPrcInfo.hProcess, WAIT_INFINITE) lngSizeOf = GetFileSize(hRead, 0&) If (lngSizeOf > 0) Then ReDim abytBuff(lngSizeOf - 1) If ReadFile(hRead, abytBuff(0), UBound(abytBuff) + 1, bRead, ByVal 0&) Then Redirect = StrConv(abytBuff, vbUnicode) End If End If Call GetExitCodeProcess(tSA_CreateProcessPrcInfo.hProcess, lngExitCode) CloseHandle tSA_CreateProcessPrcInfo.hThread CloseHandle tSA_CreateProcessPrcInfo.hProcess If (lngExitCode <> 0&) Then Err.Raise vbObject + 1235&, "GetExitCodeProcess", "Non-zero Application exist code" CloseHandle hWrite CloseHandle hRead Else Err.Raise vbObject + 1236&, "CreateProcess", "CreateProcess Failed, Code: " & Err.LastDllError End If End If End Function Public Function MainRedirect(param As String) Dim resp As String resp = Redirect(CurrentProject.Path & "\" & "app.exe", param) MainRedirect = resp End Function طبعاً app.exe هو اسم التطبيق الذي قمنا بعمله في الأعلى ووضعناه بجانب قاعدة بيانات الأكسس. الإستدعاء: Private Sub cmd_send_Click() MsgBox MainRedirect("hi") End Sub النتيجة: وأخيراً، استميحك عذراً في الإجابة عن هذا السؤال الموجه لأخي @د.كاف يار أغلب الطرق فاشلة وغير فعالة وهي بتحويل البرامج المكتوبة في الدوت نت الى مكتبات بصيغة tlb. لكن أؤكد لك انها طرق فاشلة وغير فعالة، هناك طريقة وجدتها سابقا وهي تحميل مكتبة دوت نت في لغات غير الدوت نت - Load vb.net to unmanaged process https://www.dev-point.com/vb/threads/389438 هذا هو الدرس، لمن يريد قراءته.. وأخيراً، ارجو ان اكون قد وفقت بإيصال الفكرة ولو بالشيء اليسير تحياتي لك يا مُعلمي @jjafferr

يختلف استدعاء المكتبة من لغة برمجة لأخرى.. وكذلك الإتصال، حدد اللغة التي تريد العمل عليها، ثم ابحث عن طريقة الاتصال واستدعاء المكتبة فـ google سيعطيك الاجابات الكافية لذلك

عليكم السلام، اشرح بصورة أبسط لكي نتمكن من مساعدتك.

احسنت استاذ صالح شرح رائع من شخص أروع بارك الله بك وزادك من علمه