اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

SEMO.Pa3x

الخبراء
  • Posts

    540
  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    11

كل منشورات العضو SEMO.Pa3x

  1. الشيء الذي أغضبني منك هو هذا الموضوع انا لا اقوم بهدر وقتي في عمل برامج خارجية مساعدة للأكسس وقمت بعمل البرنامج لك واستغرق مني 3 ساعات متواصلة لأتفاجئ بأنك لم ترى الموضوع حتى ولم تقل لي هل نجحت الطريقة ام لا اعتذارك مقبول اخي الكريم
  2. نظراً لإهمالك في متابعة مواضيعك السابقة انا عن نفسي لن اقوم بمساعدتك.
  3. الموضوع أبسط مما تتخيل لكن الأكسس عاجز وحده والسبب لا يمكن ارسال نسق التشفير الـ ( Encoding ) لذلك استعن بلغة اخرى حمل هذا البرنامج مكتوب بلغة #C ثم قم بتعديله https://www.codeproject.com/Articles/12711/Google-Translator ثم قم بعمل نداء بواسطة CommandLine يرسل 3 امور رئيسية: اولاً: اللغة المراد الترجمة منها ثانياً: اللغة المراد الترجمة اليها ثالثاً: النص المراد ترجمتة سيقوم البرنامج المساعد بترجمة النص وفق المعطيات ومن ثم سيقوم بإرجاع المخرجات لك على شكل Args قم بقراءتها في برنامج، وانتهى الموضوع.
  4. المثال مكتوب بالأكسس + VB.NET أولا: تحتاج 3 براميترات... الأول: مفتاح الإتصال بقاعدة البيانات SQLServer ثانياً: اسم الباك أب لقاعدة البيانات ثالثاً: مسار حفظ الباك أب Option Compare Database Private Sub Backup_Click() Dim BAK_File As String Dim SQLConnectionString As String Dim DatabaseBackupName As String Dim DatabaseBackupPath As String Dim Parameters As String BAK_File = CurrentProject.Path + "\BAK.exe" SQLConnectionString = "Data Source=.\SEMICOLONSQL;Persist Security Info=True;Database=AlraedDb;User id=sa;password=123@a;" DatabaseBackupName = "Backup" DatabaseBackupPath = "E:" DatabaseName = "AlraedDb" Parameters = SQLConnectionString & "," & DatabaseBackupName & "," & DatabaseBackupPath & "\" & "," & DatabaseName Call Shell(BAK_File & " " & """" & Parameters & """", vbNormalFocus) End Sub سورس ملف الـ VB.NET Imports System.Data.SqlClient Module BAK Sub Main() 'c0ded bY: SEMO.Pa3x 'date: 23-5-2021 : 05:01 PM For Each arg As String In My.Application.CommandLineArgs Dim argArray() As String = Split(arg, ",") 'vars to split args Dim SQLConnectionString As String = argArray(0) Dim DatabaseBackupName As String = argArray(1) & " " & DateTime.Now.ToString("yyyy-MM-dd-HH-mm tt") Dim DatabaseBackupPath As String = argArray(2) Dim DatabaseName As String = argArray(3) Using con = New SqlConnection(SQLConnectionString) 'open connection con.Open() 'check connection is open ? If con.State = ConnectionState.Open Then 'check connection is open ? Dim str As String = "backup database " & DatabaseName & " to disk='" & DatabaseBackupPath & DatabaseBackupName & ".BAK' WITH INIT" Using cmd = New SqlCommand(str, con) cmd.ExecuteNonQuery() End Using con.Close() End If End Using Next End Sub End Module مدة العمل ( 3 ساعات ) وأنا أكتب الأكواد Backup_By_SEMO_Pa3x.rar
  5. عليكم السلام، طبق هذه الخيارات
  6. عليكم السلام، ارفق قاعدة بياناتك لكي نقوم بمساعدتك.
  7. لا اضن ان ذلك ممكن من خلال الأكسس. يمكنك استعمال لغة اخرى لعمل الباك اب مثلاً انا هنا استعملت لغة Visual Studio .NET Using con = New SqlConnection("Data Source=.\SQLEXPRESS;User id=sa;password=admin;") con.Open() Dim str As String = "backup database OFFICEMANAGEMENT to disk='C:\TMP\OM.bak' WITH INIT" Using cmd = New SqlCommand(str, con) cmd.ExecuteNonQuery() End Using con.Close() End Using ستقوم بعمل تطبيق تمرر له براميتر ( CommandLine ) يتضمن معلومات الاتصال بالسيرفر ومسار حفظ الباك اب وهو بدوره سيقوم بهذه العملية. مودتي
  8. عليكم السلام. Private Function GTranslate(strInput As String, strFromLang As String, strToLang As String) As String Dim strURL As String, objHTTP As Object, objHTML As Object, objDivs As Object, objDiv As Variant strURL = "https://translate.google.com/m?hl=" & strFromLang & _ "&sl=" & strFromLang & _ "&tl=" & strToLang & _ "&ie=UTF-8&prev=_m&q=" & strInput Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP") objHTTP.Open "GET", strURL, False objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)" objHTTP.Send "" Set objHTML = CreateObject("htmlfile") With objHTML .Open .Write objHTTP.responseText .Close End With Set objDivs = objHTML.getElementsByTagName("div") For Each objDiv In objDivs Debug.Print objDiv.innerText If objDiv.className = "result-container" Then GTranslate = objDiv.innerText: Exit For End If Next objDiv Set objHTML = Nothing: Set objHTTP = Nothing End Function Private Sub cmd_ar_Click() MsgBox GTranslate(txt_from, "auto", "ar") End Sub Private Sub cmd_en_Click() txt_translate = GTranslate(txt_from, "auto", "en") End Sub
  9. السلام عليكم، أحياناً تواجهنا مشكلة في الأكسس وهي تحول الارقام الى العربية خصوصاً اذا كان بجانب الرقم حروف عربية لذلك دعونا نختصر الوقت على العميل ونقوم بتعديل تنسيقات التاريخ والارقام..الخ برمجياً بدون الطلب من العميل تعديلها يدوياً اقدم لكم فنكشن للتعديل، يمكنكم التعديل والإضافة بحسب ماتجدوه مناسباً. Public Sub EditControlPanelInternational() 'Define a key registry path Dim strComputer Dim objRegistry Dim strKeyPath Dim strValueName Dim getValue Dim regKeyPath Dim strLocaleName, strCountry, strshortDateValue, strlongDateValue, strshortTimeValue, strlongTimeValue, strfirstDayOfWeekValue Const HKEY_CURRENT_USER = &H80000001 strComputer = "." Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv") regKeyPath = "Control Panel\International" strLocaleName = "en-US" strCountry = "United States" strshortDateValue = "yyyy-MM-dd" strlongDateValue = "dddd, MMMM d, yyyy" strshortTimeValue = "h:mm tt" strlongTimeValue = "h:mm:ss tt" strfirstDayOfWeekValue = "6" srtnativedigits = "0123456789" objRegistry.SetStringValue HKEY_CURRENT_USER, regKeyPath, "LocaleName", strLocaleName objRegistry.SetStringValue HKEY_CURRENT_USER, regKeyPath, "sCountry", strCountry objRegistry.SetStringValue HKEY_CURRENT_USER, regKeyPath, "sShortDate", strshortDateValue objRegistry.SetStringValue HKEY_CURRENT_USER, regKeyPath, "sLongDate", strlongDateValue objRegistry.SetStringValue HKEY_CURRENT_USER, regKeyPath, "sShortTime", strshortTimeValue objRegistry.SetStringValue HKEY_CURRENT_USER, regKeyPath, "sTimeFormat", strlongTimeValue objRegistry.SetStringValue HKEY_CURRENT_USER, regKeyPath, "iFirstDayOfWeek", strfirstDayOfWeekValue objRegistry.SetStringValue HKEY_CURRENT_USER, regKeyPath, "sNativeDigits", srtnativedigits Debug.Print "Successfully changed system regional settings." End Sub للأمانة الفنكشن من كتابة saf لذلك انا قمت بإضافة السطر srtnativedigits = "0123456789" objRegistry.SetStringValue HKEY_CURRENT_USER, regKeyPath, "sNativeDigits", srtnativedigits لتغيير تنسيق الأرقام من عربي إلى انجليزي ومن ثم قمت بنقله لكم.
  10. عليكم السلام ورحمة الله وبركاته، صراحة لم افهم، حاول الشرح بصورة ابسط لكي نتمكن من مساعدتك
  11. تقبل الله صيامكم وقيامكم، اعاده الله علينا وعليكم باليمن والخير والبركات، انه سميع مجيب وكل عام وأنتم بألف خير.
  12. عليكم السلام. Sub sendOutlookEmail() Dim oApp As Outlook.Application Dim oMail As MailItem Set oApp = CreateObject("Outlook.application") Set oMail = oApp.CreateItem(olMailItem) oMail.Body = "Body of the email" oMail.Subject = "Test Subject" oMail.To = "Someone@somewhere.com" oMail.Send Set oMail = Nothing Set oApp = Nothing End Sub
  13. Option Compare Database 'جلب البيانات في حال البحث والإختيار من القائمة المنسدلة Private Sub ba_AfterUpdate() fta.Requery Call CheckManagementDate Call CheckManagementBoolean End Sub 'جلب البيانات في حال الضغط على الأسم الأعلى والأسفل Private Sub ba_KeyUp(KeyCode As Integer, Shift As Integer) '40 = arrow down '38 = arrow up If KeyCode = 38 Or KeyCode = 40 Then Me.Recalc fta.Requery ba.Dropdown Call CheckManagementDate Call CheckManagementBoolean End If End Sub 'اذا كان الحقل عليه علامة صح في الجدول معناها ان الادارة منتهية والعكس Sub CheckManagementBoolean() Dim ManagementBoolean As Boolean ManagementBoolean = ba.Column(3) If (ManagementBoolean = True) Then MsgBox "الادارة منتهية" Else MsgBox "الادارة غير منتهية" End If End Sub 'اذا كان حقل التاريخ في الجدول أصغر من أو يساوي التاريخ الحالي معناها ان الادارة منتهية والعكس Sub CheckManagementDate() Dim ManagementDate As Date ManagementDate = ba.Column(2) If (ManagementDate <= Date) Then MsgBox "الادارة منتهية" Else MsgBox "الادارة غير منتهية" End If End Sub تفضل جرب وأخبرني النتيجة بحث تلقائي.accdb
  14. عليكم السلام ورحمة الله وبركاته. تفضل حمل المرفق. بخصوص طلبك الثاني بخصوص الإدارة الملغية والتأريخ صراحة لم افهمة. كيف اعرف ان التاريخ قد انتهى؟ لماذا لا تقم بعمل CheckBox في الجدول اذا تم وضع علامة صح معناها ان الادارة منتهية والعكس. بحث تلقائي.accdb
  15. عليكم السلام ورحمة الله وبركاته، الحمدلله انا بخير، شكرا لسؤالك شكرا لك استاذ صالح، صراحة اغنيت رصيدي المعرفي، لان سابقاً قمت بعمل برنامج لكي يؤدي هذا الغرض.
  16. عليكم السلام. الأكسس وحده لا يكفي! يجب عليك ان تقوم بعمل برنامج بلغة برمجة اخرى وليكن مثلا VB.NET ومن ثم ستقوم بتمرير الرسالة من الأكسس لهذا البرنامج وسيقوم هو بدوره بعرض الرسائل على شريط المهام.
  17. عليكم السلام.. CurrentDb.TableDefs("ShouldImportMetricsIDsTable").Fields("ImportStatus").DefaultValue = "No"
  18. عليكم السلام. أولاً: قم بوضع Combobox مربع سرد وتحرير ولا تقم بإعطاءه اي بيانات ثانياً: قم بوضع عدد الأعمدة فيه 2 ثالثاً: قم بوضع عرض الأعمدة 0;5cm رابعاً: في حدث ( عند مفتاح للأعلى ) أو ( KeyUp ) ضع الكود الآتي Private Sub comb_model_KeyUp(KeyCode As Integer, Shift As Integer) 'test number of characters entered - if greater then 2 then assign rowsource If Len(Me.comb_model.Text) > 2 Then 'set the rowsource to match user search criteria Me.comb_model.RowSource = "SELECT * FROM tbl_models WHERE model_name LIKE '*" & Me.comb_model.Text & "*'" 'show the search in real-time Me.comb_model.Dropdown Else 'set to no Me.comb_model.RowSource = "" End If End Sub
  19. عليكم السلام، تفضل: Public Function startsWith(str As String, prefix As String) As Boolean startsWith = Left(str, Len(prefix)) = prefix End Function Private Sub cmd_checkGender_Click() Dim vCheckGender As Boolean Dim vGenderStr As String vGender = startsWith("Here Your Number Student", "10") If vGender = True Then vGenderStr = "ÐßÑ" Else vGenderStr = "ÃäËì" End If MsgBox vGenderStr End Sub استبدل العبارة ( Here Your Number Student ) برقم الطالب.
  20. ارفق قاعدة بياناتك لكي نتمكن من مساعدتك.
  21. عليكم السلام، تفضل: Private Sub cmd_getDate_Click() 'c0ded bY: SEMO.Pa3x Dim lastDate As String lastDate = DMax("myDate", "tblMyTable", "myDate < " & "#" & DateNow & "#") MsgBox lastDate End Sub
  22. عليكم السلام، أعد ترتيب الحقول بحيث تكون بشكل عمودي
  23. عليكم السلام، ضع الأمر في حدث Report_Current Private Sub Report_Current() DoCmd.Maximize End Sub
  24. عليكم السلام.. ارفق قاعدة بياناتك حتى يتسنى لنا مساعدتك.
×
×
  • اضف...

Important Information